Eğer ile hücre biçimlendirme

T

Teknoas

Katılım
8 Kasım 2024
Mesajlar
20
Excel Vers. ve Dili
professional plus 2019
tugkan' Alıntı:
Dener misiniz?
A sütununa "Şirket" yazıldığında ilgili hücrelerin birleşmesini sağlayacak şekilde kodu düzenledik. Bu sayede yalnızca "Şirket" kelimesi girildiğinde birleşme işlemi gerçekleşecek; başka herhangi bir değer girildiğinde birleşme yapılmayacaktır.
Ayrıca diğer kodunuzu da bununla birleştirdik.

Güncel Kod

Kod: 
Private Sub TextBox1_Change()
    ' TextBox1 değişiminde yapılacak işlemler burada tanımlanabilir
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' A sütununda "Şirket" kelimesi girildiğinde C-D ve K sütunlarındaki hücreleri birleştirme işlemi
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim satirNo As Long
        satirNo = Target.Row
     
        ' A sütununa "Şirket" yazıldığında ilgili satırdaki hücreleri birleştir
        If Target.Value = "Şirket" Then
            ' C sütunundaki hücreleri birleştir
            Me.Range("C" & satirNo & ":C" & satirNo + 1).Merge
         
            ' D sütunundaki hücreleri birleştir
            Me.Range("D" & satirNo & ":D" & satirNo + 1).Merge
         
            ' K sütunundaki hücreleri birleştir
            Me.Range("K" & satirNo & ":K" & satirNo + 1).Merge
        Else
            ' Eğer A sütununda "Şirket" değilse birleşimleri kaldır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
        End If
    End If
 
    ' F1:J2000 aralığında değişiklik yapılırsa, ilgili satırda L sütununa tarihi ekleme işlemi
    If Not Intersect(Target, Range("F1:J2000")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 12).Value = Date
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' E1:E10000 aralığında seçim yapıldığında seçilen hücreyi kopyalama işlemi
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    End If
End Sub
Kodun Çalışma Mantığı
  • A Sütununda "Şirket" Kontrolü: Worksheet_Change kodu, A sütununda bir değişiklik olduğunda çalışır. A sütununa "Şirket" yazıldığında, belirtilen hücreleri (C, D ve K sütunları) birleştirir. Başka bir değer yazıldığında ise birleşmiş hücreleri otomatik olarak ayrır.
  • Tarih Ekleme: F1:J2000 aralığında bir değişiklik yapıldığında, ilgili satırda L sütununa otomatik olarak o günün tarihini ekler.
  • Seçim Yapıldığında Kopyalama: E1:E10000 aralığında bir hücre seçildiğinde, o hücreyi otomatik olarak kopyalar.
Bu güncelleme ile yalnızca A sütununa "Şirket" yazıldığında birleşme işlemi yapılacak.
Genişletmek için tıkla ...

Elinize sağlık çok güzel olmuş hersey istediğim gibi olmuş şirket yazdığımda biçimledirme yapıyor diğer türlü yapmıyor çok küçük bir pürüz kalmış o da şirket yazdığımda biçimlendirme yapıyor ama şirket ifadesini kaldırdığımda biçimlendirmeyi geri almıyor onu da yaparsak her şeye tamam olmuş olacak
 
tugkan

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
477
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
Dener misiniz.
A sütunundaki "Şirket" yazısını sildiğinizde, biçimlendirmeyi geri almak için mevcut olan birleşimleri kaldırmamız gerekiyor. Bu durumda, A sütununa "Şirket" yazıldığında hücreleri birleştirirken, "Şirket" silindiğinde birleşmeleri geri alacağız.

Aşağıdaki kod, istediğiniz şekilde güncellenmiştir:

Güncel Kod
Kod: 
Private Sub TextBox1_Change()
    ' TextBox1 değişiminde yapılacak işlemler burada tanımlanabilir
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' A sütununda "Şirket" kelimesi girildiğinde C-D ve K sütunlarındaki hücreleri birleştirme işlemi
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim satirNo As Long
        satirNo = Target.Row
      
        ' A sütununa "Şirket" yazıldığında ilgili satırdaki hücreleri birleştir
        If Target.Value = "Şirket" Then
            ' C sütunundaki hücreleri birleştir
            Me.Range("C" & satirNo & ":C" & satirNo + 1).Merge
          
            ' D sütunundaki hücreleri birleştir
            Me.Range("D" & satirNo & ":D" & satirNo + 1).Merge
          
            ' K sütunundaki hücreleri birleştir
            Me.Range("K" & satirNo & ":K" & satirNo + 1).Merge
        ElseIf Target.Value = "" Then
            ' Eğer A sütunundaki değer silindiyse, hücreleri ayır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
        Else
            ' Eğer A sütununa "Şirket" dışında bir şey yazıldıysa, birleşimleri kaldır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
        End If
    End If
  
    ' F1:J2000 aralığında değişiklik yapılırsa, ilgili satırda L sütununa tarihi ekleme işlemi
    If Not Intersect(Target, Range("F1:J2000")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 12).Value = Date
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' E1:E10000 aralığında seçim yapıldığında seçilen hücreyi kopyalama işlemi
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    End If
End Sub
Kodun Çalışma Mantığı
  • "Şirket" Yazıldığında: A sütununa "Şirket" yazıldığında, belirtilen hücreler (C, D, ve K sütunları) birleştirilecektir.
  • "Şirket" Silindiğinde: A sütunundaki değer silindiğinde (yani boş bırakıldığında), C, D, ve K sütunlarındaki birleşimler otomatik olarak geri alınacaktır.
  • Başka Bir Değer Yazıldığında: A sütununa "Şirket" dışında başka bir değer yazıldığında, yine hücrelerin birleşmesi kaldırılacaktır.
  • F1

    Aralığında Değişiklik:    F1:J2000 aralığında bir değişiklik yapıldığında, aynı satırdaki L sütununa günün tarihi eklenecektir.

  • E1

    Aralığında Seçim Yapıldığında:    E sütununda belirtilen aralıkta bir hücre seçildiğinde, o hücre kopyalanacaktır.
Bu kod ile "Şirket" yazısı silindiğinde, biçimlendirme (birleşme) işlemi geri alınacaktır.
 
T

Teknoas

Katılım
8 Kasım 2024
Mesajlar
20
Excel Vers. ve Dili
professional plus 2019
tugkan' Alıntı:
Dener misiniz?
A sütununa "Şirket" yazıldığında ilgili hücrelerin birleşmesini sağlayacak şekilde kodu düzenledik. Bu sayede yalnızca "Şirket" kelimesi girildiğinde birleşme işlemi gerçekleşecek; başka herhangi bir değer girildiğinde birleşme yapılmayacaktır.
Ayrıca diğer kodunuzu da bununla birleştirdik.

Güncel Kod

Kod: 
Private Sub TextBox1_Change()
    ' TextBox1 değişiminde yapılacak işlemler burada tanımlanabilir
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' A sütununda "Şirket" kelimesi girildiğinde C-D ve K sütunlarındaki hücreleri birleştirme işlemi
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim satirNo As Long
        satirNo = Target.Row
    
        ' A sütununa "Şirket" yazıldığında ilgili satırdaki hücreleri birleştir
        If Target.Value = "Şirket" Then
            ' C sütunundaki hücreleri birleştir
            Me.Range("C" & satirNo & ":C" & satirNo + 1).Merge
        
            ' D sütunundaki hücreleri birleştir
            Me.Range("D" & satirNo & ":D" & satirNo + 1).Merge
        
            ' K sütunundaki hücreleri birleştir
            Me.Range("K" & satirNo & ":K" & satirNo + 1).Merge
        Else
            ' Eğer A sütununda "Şirket" değilse birleşimleri kaldır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
        End If
    End If

    ' F1:J2000 aralığında değişiklik yapılırsa, ilgili satırda L sütununa tarihi ekleme işlemi
    If Not Intersect(Target, Range("F1:J2000")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 12).Value = Date
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' E1:E10000 aralığında seçim yapıldığında seçilen hücreyi kopyalama işlemi
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    End If
End Sub
Kodun Çalışma Mantığı
  • A Sütununda "Şirket" Kontrolü: Worksheet_Change kodu, A sütununda bir değişiklik olduğunda çalışır. A sütununa "Şirket" yazıldığında, belirtilen hücreleri (C, D ve K sütunları) birleştirir. Başka bir değer yazıldığında ise birleşmiş hücreleri otomatik olarak ayrır.
  • Tarih Ekleme: F1:J2000 aralığında bir değişiklik yapıldığında, ilgili satırda L sütununa otomatik olarak o günün tarihini ekler.
  • Seçim Yapıldığında Kopyalama: E1:E10000 aralığında bir hücre seçildiğinde, o hücreyi otomatik olarak kopyalar.
Bu güncelleme ile yalnızca A sütununa "Şirket" yazıldığında birleşme işlemi yapılacak.
Genişletmek için tıkla ...

Elinize sağlık çok güzel olmuş hersey istediğim gibi olmuş şirket yazdığımda biçimledirme yapıyor diğer türlü yapmıyor çok küçük bir pürüz kalmış o da şirket yazdığımda biçimlendirme yapıyor ama şirket ifadesini kaldırdığımda biçimlendirmeyi geri almıyor onu da yaparsak her şeye tamam olmuş olacak
 
tugkan

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
477
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
22 numaralı mesajı okudunuz mu? Yoksa yanlışlıkla mı yazdınız anlamadım.
Teknoas' Alıntı:
Elinize sağlık çok güzel olmuş hersey istediğim gibi olmuş şirket yazdığımda biçimledirme yapıyor diğer türlü yapmıyor çok küçük bir pürüz kalmış o da şirket yazdığımda biçimlendirme yapıyor ama şirket ifadesini kaldırdığımda biçimlendirmeyi geri almıyor onu da yaparsak her şeye tamam olmuş olacak
Genişletmek için tıkla ...
 
T

Teknoas

Katılım
8 Kasım 2024
Mesajlar
20
Excel Vers. ve Dili
professional plus 2019
Daha doğrusu hücre çizgileri eski haline dönmemiş biçimlendirmeyi geri almış ama eksik söylemişim
 
tugkan

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
477
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
Anladığım kadarıyla sadece hücre çizgileri eski haline dönmedi, diğer her şey tamam doğru mu?
 
tugkan

tugkan

Altın Üye
Katılım
6 Kasım 2004
Mesajlar
477
Excel Vers. ve Dili
Excel 2016
Türkçe 64 BIT
Altın Üyelik Bitiş Tarihi
16-10-2025
Dener misin?

Aşağıdaki güncel kodu kullanarak, "Şirket" silindiğinde hücrelerin birleşmesini kaldırırken aynı zamanda kenarlıkları eski haline getirebiliriz.

Güncellenmiş Kod
Kod: 
Private Sub TextBox1_Change()
    ' TextBox1 değişiminde yapılacak işlemler burada tanımlanabilir
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' A sütununda "Şirket" kelimesi girildiğinde C-D ve K sütunlarındaki hücreleri birleştirme işlemi
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim satirNo As Long
        satirNo = Target.Row
      
        ' A sütununa "Şirket" yazıldığında ilgili satırdaki hücreleri birleştir
        If Target.Value = "Şirket" Then
            ' C sütunundaki hücreleri birleştir
            Me.Range("C" & satirNo & ":C" & satirNo + 1).Merge
          
            ' D sütunundaki hücreleri birleştir
            Me.Range("D" & satirNo & ":D" & satirNo + 1).Merge
          
            ' K sütunundaki hücreleri birleştir
            Me.Range("K" & satirNo & ":K" & satirNo + 1).Merge
        ElseIf Target.Value = "" Then
            ' Eğer A sütunundaki değer silindiyse, hücreleri ayır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
          
            ' Hücrelerin kenarlıklarını eski haline getirme
            Me.Range("C" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("C" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
            Me.Range("D" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("D" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
            Me.Range("K" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("K" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
        Else
            ' Eğer A sütununa "Şirket" dışında bir şey yazıldıysa, birleşimleri kaldır
            Me.Range("C" & satirNo & ":C" & satirNo + 1).UnMerge
            Me.Range("D" & satirNo & ":D" & satirNo + 1).UnMerge
            Me.Range("K" & satirNo & ":K" & satirNo + 1).UnMerge
          
            ' Hücrelerin kenarlıklarını eski haline getirme
            Me.Range("C" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("C" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
            Me.Range("D" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("D" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
            Me.Range("K" & satirNo).Borders(xlEdgeBottom).LineStyle = xlContinuous
            Me.Range("K" & satirNo).Borders(xlEdgeRight).LineStyle = xlContinuous
        End If
    End If
  
    ' F1:J2000 aralığında değişiklik yapılırsa, ilgili satırda L sütununa tarihi ekleme işlemi
    If Not Intersect(Target, Range("F1:J2000")) Is Nothing Then
        Application.EnableEvents = False
        Cells(Target.Row, 12).Value = Date
        Application.EnableEvents = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' E1:E10000 aralığında seçim yapıldığında seçilen hücreyi kopyalama işlemi
    If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
        Target.Copy
    End If
End Sub
Açıklama:
  • Kenarlıkların Eski Haline Getirilmesi: Eğer A sütunundaki değer boşsa (yani "Şirket" silindiyse), o satırdaki hücreler için Borders özelliği kullanarak kenarlıklar yeniden ayarlanır. Bu şekilde, hücre birleşmesinin kaldırılmasının ardından kenarlıklar yeniden görünür olacaktır.
  • xlEdgeBottom ve xlEdgeRight Kullanımı: Bu, hücrelerin alt ve sağ kenarlıklarını belirler. Aynı işlemi diğer kenarlıklar için de uygulamak isterseniz, xlEdgeTop ve xlEdgeLeft kenarlıklarını da ekleyebilirsiniz.
Bu kodla, "Şirket" ifadesi silindiğinde hücre birleşimi geri alınacak ve kenarlıklar da eski haline dönecektir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst