Soru Birleştirilmiş Hücrede Girilen Veriye Göre Satır Genişlemesi

Hsn55 · Salı saat 14:23'de

İyi günler ekli örnek dosyada veri girişi sayfasında D7

50 satırlarına ver girdiğim zaman girilen veri kadar A,B,C,D sayfalarına aynı verilerin kopyalanması ve girilen veri kadar ilgili satırların genişlemesini nasıl sağlayabiliriz. Not: Satır genişlemesi yapılacak sayfalar :Veri Girişi,A,B,C,D sayfaları olacak. Destek olursanız sevinirim.
satir_genislemesi.xlsx https://s6.dosya.tc/server22/kdllm5/satir_genislemesi.xlsx.html

volki_112 · Salı saat 14:40'de

Hsn55' Alıntı:
İyi günler ekli örnek dosyada veri girişi sayfasında D750 satırlarına ver girdiğim zaman girilen veri kadar A,B,C,D sayfalarına aynı verilerin kopyalanması ve girilen veri kadar ilgili satırların genişlemesini nasıl sağlayabiliriz. Not: Satır genişlemesi yapılacak sayfalar :Veri Girişi,A,B,C,D sayfaları olacak. Destek olursanız sevinirim.
satir_genislemesi.xlsx https://s6.dosya.tc/server22/kdllm5/satir_genislemesi.xlsx.html

kontrol edip dönüş yapınız.

Hsn55 · Salı saat 14:47'de

Sayın volki_112 benim istediğim bu şekilde değil. Veri giriş sayfasında örneğin birleştirilmiş d7 satırına uzun bir metin girdiğim zaman girilen metin kadar satır genişleyecek

volki_112 · Salı saat 14:50'de

Hsn55' Alıntı:
Sayın volki_112 benim istediğim bu şekilde değil. Veri giriş sayfasında örneğin birleştirilmiş d7 satırına uzun bir metin girdiğim zaman girilen metin kadar satır genişleyecek

makro ile satır genişliği auto yapılacak. deneyeyim

volki_112 · Salı saat 15:51'de

volki_112' Alıntı:
makro ile satır genişliği auto yapılacak. deneyeyim

@Hsn55 ben yapmaya çalıştım ama yapamadım

Biolightant · Salı saat 17:49'de

Merhaba,
@volki_112 kodlarını malesef göremiyorum ama şöyle bir yöntem işinize yarayabilir.

C++:

Sub EsitGenisle()

    Dim ws As Worksheet
    Dim sutunGenislik As Double
    
    Set ws = ActiveSheet
    
    ' D7:N7 hücrelerini seç ve birleştirmeyi kaldır
    ws.Range("D7:N7").UnMerge
    
    ' D sütununun genişliğini öğren
    ws.Columns("D:D").AutoFit
    sutunGenislik = ws.Columns("D:D").ColumnWidth / 11 ' 11'e böl
    
    ' Hücreleri tekrar birleştir
    ws.Range("D7:N7").Merge
    
    ' Yeni genişliği uygula
    ws.Range("D7:N7").ColumnWidth = sutunGenislik
End Sub

volki_112 · Salı saat 18:21'de

Biolightant' Alıntı:

Merhaba,
@volki_112 kodlarını malesef göremiyorum ama şöyle bir yöntem işinize yarayabilir.

C++:

Sub EsitGenisle()

    Dim ws As Worksheet
    Dim sutunGenislik As Double
    
    Set ws = ActiveSheet
    
    ' D7:N7 hücrelerini seç ve birleştirmeyi kaldır
    ws.Range("D7:N7").UnMerge
    
    ' D sütununun genişliğini öğren
    ws.Columns("D:D").AutoFit
    sutunGenislik = ws.Columns("D:D").ColumnWidth / 11 ' 11'e böl
    
    ' Hücreleri tekrar birleştir
    ws.Range("D7:N7").Merge
    
    ' Yeni genişliği uygula
    ws.Range("D7:N7").ColumnWidth = sutunGenislik
End Sub

Sutun genisligi değil. Satir yuksekligi artacak hocam

Korhan Ayhan · Çarşamba saat 13:08'de

Sayfanızın (VERİ GİRİŞİ) kod bölümüne uygulayıp deneyiniz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D7:N50")) Is Nothing Then
        Dim WS As Worksheet, S1 As Worksheet, S2 As Worksheet
        Dim XWidth As Integer, XHeight As Integer
        Dim Rng As Range, My_Data As Variant, Last_Row As Long
        Dim No As Integer, X As Integer, Count As Integer
            
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        Set S1 = Sheets("VERİ GİRİŞİ")
        S1.Range("C7:C50").VerticalAlignment = xlCenter
        S1.Range("C7:C50").Font.Bold = True
        S1.Range("D7:N50").WrapText = True
        S1.Range("D7:N50").EntireRow.AutoFit
        
        For Each WS In Sheets(Array("A", "B", "C", "D"))
            S1.Range("C7:R50").Copy WS.Range("C7:R50")
            WS.Range("D7:N50").WrapText = True
            WS.Range("D7:N50").EntireRow.AutoFit
        Next
        
        On Error Resume Next
        Sheets("Test").Delete
        On Error GoTo 0
        
        Sheets.Add
        Set S2 = ActiveSheet
        S2.Name = "Test"
        
        For Each Rng In S1.Range("D7:N50").Columns(1).Cells
            If Rng.Value <> "" Then
                XWidth = S1.Range("D7:N7").Columns.Width
                XHeight = 0
                
                No = 2
                
                With S2
                    .Cells.Delete
                    .Cells.Font.Size = Rng.Font.Size
                    .Range("A1") = Rng.Value
                    .Range("A:A").WrapText = True
                    .Range("A1").VerticalAlignment = xlJustify
                    .Range("A1").ColumnWidth = XWidth / 5.3
                    .Range("A1").EntireRow.AutoFit
                    
                    My_Data = Split(.Range("A1"), Chr(10))
                    
                    For X = 0 To UBound(My_Data)
                        .Cells(No, 1) = My_Data(X)
                        XHeight = XHeight + .Cells(No, 1).RowHeight
                        No = No + 1
                    Next
                    
                    .Cells.Delete
                End With
                
                If XHeight = 0 Then XHeight = 15
                Rng.RowHeight = XHeight
                
                S1.Range("C7") = 1
                Last_Row = S1.Cells(50, 4).End(3).Row - 6
                S1.Range("C7").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Stop:=Last_Row, Trend:=False
                
                For Each WS In Sheets(Array("A", "B", "C", "D"))
                    S1.Range("C7:R50").Copy WS.Range("C7:R50")
                    WS.Range("D7:N50").WrapText = True
                    WS.Rows(Rng.Row).RowHeight = XHeight
                    WS.Range("D7:D50").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
                Next
            End If
        Next
    
        On Error Resume Next
        S2.Delete
        On Error GoTo 0
        
        Set S1 = Nothing
        Set S2 = Nothing
        Set WS = Nothing
    
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If
End Sub

Hsn55 · Dün 08:33 da

Korhan Ayhan' Alıntı:

Sayfanızın (VERİ GİRİŞİ) kod bölümüne uygulayıp deneyiniz.

C++:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D7:N50")) Is Nothing Then
        Dim WS As Worksheet, S1 As Worksheet, S2 As Worksheet
        Dim XWidth As Integer, XHeight As Integer
        Dim Rng As Range, My_Data As Variant
        Dim No As Integer, X As Integer
          
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
      
        Set S1 = Sheets("VERİ GİRİŞİ")
        S1.Range("D7:N50").WrapText = True
      
        On Error Resume Next
        Sheets("Test").Delete
        On Error GoTo 0
      
        Sheets.Add
        Set S2 = ActiveSheet
        S2.Name = "Test"
      
        For Each Rng In S1.Range("D7:N50").Columns(1)
            If Rng.Cells(1).Value <> "" Then
                XWidth = S1.Range("D7:N7").Columns.Width
                XHeight = 0
              
                No = 2
              
                With S2
                    .Cells.Delete
                    .Cells.Font.Size = Rng.Font.Size
                    .Range("A1") = Rng.Cells(1).Text
                    .Range("A:A").WrapText = True
                    .Range("A1").VerticalAlignment = xlJustify
                    .Range("A1").ColumnWidth = XWidth / 5.3
                    .Range("A1").EntireRow.AutoFit
                  
                    My_Data = Split(.Range("A1"), Chr(10))
                  
                    For X = 0 To UBound(My_Data)
                        .Cells(No, 1) = My_Data(X)
                        XHeight = XHeight + .Cells(No, 1).RowHeight
                        No = No + 1
                    Next
                  
                    .Cells.Delete
                End With
              
                If XHeight = 0 Then XHeight = 15
                Rng.Cells(1).RowHeight = XHeight
              
                For Each WS In Sheets(Array("A", "B", "C", "D"))
                    S1.Range("D7:N50").Copy WS.Range("D7:N50")
                    WS.Range("D7:N50").WrapText = True
                    WS.Rows(Rng.Cells(1).Row).RowHeight = XHeight
                Next
            End If
        Next
  
        On Error Resume Next
        S2.Delete
        On Error GoTo 0
      
        Set S1 = Nothing
        Set S2 = Nothing
        Set WS = Nothing
  
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    End If
End Sub

Korhan bey merhabalar, satır genişlemesi sadece 7. satırda oluyor. diğerlerinde olmadı

Hsn55 · Dün 08:54 da

Korhan bey merhabalar, satır genişlemesi sadece 7. satırda oluyor. diğerlerinde olmadı. Birde hocam Veri Girişi sayfasında D7

50 hücrelerinde veri olmayan satırlar A-B-C-D sayfalarında gizlenebilir mi. Veri Girişi sayfası gizlenmeyecek. Ayrıca veri girişi sayfasındaki verileri sildiğim zaman veri girişi sayfası ve diğer sayfalardaki veriler silinmiyor. Satırlarda veriye göre daralıp genişlemiyor

Korhan Ayhan · Dün 10:19 da

Kodu revize ettim. Tekrar deneyiniz.

Hsn55 · Dün 10:26 da

Korhan bey hocam yardımınız için çok teşekkür ederim. Sadece bir yer yerde sıkıntı var . Örneğin veri girişi sayfası 10.satırda işlem yaptığım zaman diğer sayfalara veri kopyalanmıyor. Satır atlamadan işlem yaptığım zaman oluyor. Örneğin ben 8,15,25 satırlarda işlem yaptığım zaman da aynı şekilde kopyalama ve satır genişlemesi olabilir mi?

Korhan Ayhan · Dün 10:36 da

Sıralı veri girişi yapılacağını düşünmüştüm.

Tekrar revize ettim..

Hsn55 · Dün 10:42 da

Hocam sizi uğraştırmayacaksa . Diğer sayfalara veri kopyalama işi . C7:R50 hücre aralığında .Satır genişlemesinde değişiklik olmayacak yani D7:N50 hücre aralığında olabilir mi?

Korhan Ayhan · Dün 10:56 da

Kod aslında gayet açık... Bu revizeleri sizde yapabilirsiniz.

Kodu tekrar revize ettim..

Hsn55 · Dün 11:05 da

Hocam D7:N50 hücre aralığında işlem yaptığımda C7:C50 hücrelerine 1 den başlayarak sıra numarası verilebilir mi?

Korhan Ayhan · Dün 11:08 da

Başka talepleriniz olacak mı?

Hsn55 · Dün 11:12 da

Son hocam

Korhan Ayhan · Dün 11:16 da

Atlamalı veri giriyorum demiştiniz. Sıra numarası atlanan satırlara verilecek mi? Yoksa atlanan satırlar boş mu kalacak?

Hsn55 · Dün 11:17 da

Atlanılan satırlara verilecek

Soru Birleştirilmiş Hücrede Girilen Veriye Göre Satır Genişlemesi

Hsn55

volki_112

Ekli dosyalar

Hsn55

volki_112

volki_112

Biolightant

volki_112

Korhan Ayhan

Administrator

Hsn55

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55

Korhan Ayhan

Administrator

Hsn55