Eğer ile hücre biçimlendirme

Teknoas · 8 Kasım 2024

Arkadaşlar merhaba
Sizden bir yardım talebim var.
Sorum şu :
Excelde bir hücreye bir değer girildiğinde Örneğin b3'e "bir" yazıldığında c3,c4 &d3,d4 hücreleri birleşsin istiyorum yani (4 hücre tek olsun) nasıl yapabilirim.

veysikulte1 · 8 Kasım 2024

Yeni bir modül eklemek yerine, mevcut Sheet1 (veya üzerinde çalıştığınız sayfa adı) altında bu kodu doğrudan ekleyebilirsiniz. Şu kodu Sheet1 (veya çalışma sayfanızın ismi) içine yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
' Eğer sadece bir hücrede değişiklik olduysa
    If Target.Count = 1 Then
        ' Hücrede boşluk dışında herhangi bir veri varsa
        If Len(Trim(Target.Text)) > 0 Then
            ' Hedef hücrenin kendisi ve altındaki 3 hücreyi birleştir
            On Error Resume Next ' Hata olursa geç, çünkü bazı hücreler zaten birleşmiş olabilir
            Me.Range(Target, Target.Offset(3, 0)).Merge
            On Error GoTo 0 ' Hata kontrolünü tekrar başlat
        Else
            ' Eğer hücreyi boş bırakırsanız, o hücrenin kendisi ve altındaki 3 hücreyi ayır
            On Error Resume Next
            Me.Range(Target, Target.Offset(3, 0)).UnMerge
            On Error GoTo 0
        End If
    End If
End Sub

tugkan · 8 Kasım 2024

Bu işlemi VBA kodu ile yaparak istediğiniz gibi bir hücre birleşimi sağlayabilirsiniz. Aşağıdaki adımları takip ederek B3 hücresine "bir" yazıldığında C3, C4, D3 ve D4 hücrelerini otomatik olarak birleştirebilirsiniz:

VBA modülünü açın:
- Alt + F11 tuşlarına basarak VBA editörünü açın.
Çalışma Sayfası Koduna Gitme:
- Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).
Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' B3 hücresine yazılacak değeri kontrol et
    If Target.Address = "$B$3" Then
        ' Eğer B3 hücresine "bir" yazıldıysa
        If Target.Value = "bir" Then
            ' C3:C4 ve D3:D4 hücrelerini birleştir
            Range("C3:D4").Merge
        Else
            ' Eğer B3'e "bir" dışında bir şey yazılırsa hücre birleşimini kaldır
            Range("C3:D4").UnMerge
        End If
    End If
End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında herhangi bir değişiklik olduğunda çalışacaktır.
B3 hücresine "bir" yazıldığında, C3

aralığındaki hücreleri birleştirir.
Farklı bir değer yazıldığında ise bu hücre birleşimini kaldırır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde B3 hücresine istediğiniz değeri girdiğinizde C3, C4, D3 ve D4 hücreleri otomatik olarak birleştirilecektir.

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Bu işlemi VBA kodu ile yaparak istediğiniz gibi bir hücre birleşimi sağlayabilirsiniz. Aşağıdaki adımları takip ederek B3 hücresine "bir" yazıldığında C3, C4, D3 ve D4 hücrelerini otomatik olarak birleştirebilirsiniz:

VBA modülünü açın:

Alt + F11 tuşlarına basarak VBA editörünü açın.

Çalışma Sayfası Koduna Gitme:

Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).

Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) ' B3 hücresine yazılacak değeri kontrol et If Target.Address = "$B$3" Then ' Eğer B3 hücresine "bir" yazıldıysa If Target.Value = "bir" Then ' C3:C4 ve D3:D4 hücrelerini birleştir Range("C3:D4").Merge Else ' Eğer B3'e "bir" dışında bir şey yazılırsa hücre birleşimini kaldır Range("C3:D4").UnMerge End If End If End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında herhangi bir değişiklik olduğunda çalışacaktır.

B3 hücresine "bir" yazıldığında, C3

aralığındaki hücreleri birleştirir.

Farklı bir değer yazıldığında ise bu hücre birleşimini kaldırır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde B3 hücresine istediğiniz değeri girdiğinizde C3, C4, D3 ve D4 hücreleri otomatik olarak birleştirilecektir.

Çok Teşekkür ederim istediğimi anlatabilmişim şimdi bu dediğinizi tüm sayfaya nasıl uygulayabilirim yukarıda ki örneğe ek olarak örneğin a2 hücresine "Şirket(örnek değer olarak belirttim)" yazıp c2;c3 ve d2;d3 hücreleri ve k2;k3 hücrelerini birleştirebilir miyiz. Bunu tüm çalışma sayfasına uygulamak istiyorum.

Teknoas · 8 Kasım 2024

veysikulte1' Alıntı:

Yeni bir modül eklemek yerine, mevcut Sheet1 (veya üzerinde çalıştığınız sayfa adı) altında bu kodu doğrudan ekleyebilirsiniz. Şu kodu Sheet1 (veya çalışma sayfanızın ismi) içine yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
' Eğer sadece bir hücrede değişiklik olduysa
    If Target.Count = 1 Then
        ' Hücrede boşluk dışında herhangi bir veri varsa
        If Len(Trim(Target.Text)) > 0 Then
            ' Hedef hücrenin kendisi ve altındaki 3 hücreyi birleştir
            On Error Resume Next ' Hata olursa geç, çünkü bazı hücreler zaten birleşmiş olabilir
            Me.Range(Target, Target.Offset(3, 0)).Merge
            On Error GoTo 0 ' Hata kontrolünü tekrar başlat
        Else
            ' Eğer hücreyi boş bırakırsanız, o hücrenin kendisi ve altındaki 3 hücreyi ayır
            On Error Resume Next
            Me.Range(Target, Target.Offset(3, 0)).UnMerge
            On Error GoTo 0
        End If
    End If
End Sub

Teşekkür ederim tüm sayfa olarak uygulabilir olmuş farklı bir çalışma oldu benim için teşekkür ederim

tugkan · 8 Kasım 2024

Teknoas' Alıntı:
Teşekkür ederim tüm sayfa olarak uygulabilir olmuş farklı bir çalışma oldu benim için teşekkür ederim

Bu şekilde çözüldü sanırım?

veysikulte1' Alıntı:

Yeni bir modül eklemek yerine, mevcut Sheet1 (veya üzerinde çalıştığınız sayfa adı) altında bu kodu doğrudan ekleyebilirsiniz. Şu kodu Sheet1 (veya çalışma sayfanızın ismi) içine yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
' Eğer sadece bir hücrede değişiklik olduysa
    If Target.Count = 1 Then
        ' Hücrede boşluk dışında herhangi bir veri varsa
        If Len(Trim(Target.Text)) > 0 Then
            ' Hedef hücrenin kendisi ve altındaki 3 hücreyi birleştir
            On Error Resume Next ' Hata olursa geç, çünkü bazı hücreler zaten birleşmiş olabilir
            Me.Range(Target, Target.Offset(3, 0)).Merge
            On Error GoTo 0 ' Hata kontrolünü tekrar başlat
        Else
            ' Eğer hücreyi boş bırakırsanız, o hücrenin kendisi ve altındaki 3 hücreyi ayır
            On Error Resume Next
            Me.Range(Target, Target.Offset(3, 0)).UnMerge
            On Error GoTo 0
        End If
    End If
End Sub

veysikulte1 · 8 Kasım 2024

Teknoas' Alıntı:
Teşekkür ederim tüm sayfa olarak uygulabilir olmuş farklı bir çalışma oldu benim için teşekkür ederim

rica ederim

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Bu işlemi VBA kodu ile yaparak istediğiniz gibi bir hücre birleşimi sağlayabilirsiniz. Aşağıdaki adımları takip ederek B3 hücresine "bir" yazıldığında C3, C4, D3 ve D4 hücrelerini otomatik olarak birleştirebilirsiniz:

VBA modülünü açın:

Alt + F11 tuşlarına basarak VBA editörünü açın.

Çalışma Sayfası Koduna Gitme:

Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).

Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) ' B3 hücresine yazılacak değeri kontrol et If Target.Address = "$B$3" Then ' Eğer B3 hücresine "bir" yazıldıysa If Target.Value = "bir" Then ' C3:C4 ve D3:D4 hücrelerini birleştir Range("C3:D4").Merge Else ' Eğer B3'e "bir" dışında bir şey yazılırsa hücre birleşimini kaldır Range("C3:D4").UnMerge End If End If End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında herhangi bir değişiklik olduğunda çalışacaktır.

B3 hücresine "bir" yazıldığında, C3

aralığındaki hücreleri birleştirir.

Farklı bir değer yazıldığında ise bu hücre birleşimini kaldırır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde B3 hücresine istediğiniz değeri girdiğinizde C3, C4, D3 ve D4 hücreleri otomatik olarak birleştirilecektir.

Çok Teşekkür ederim istediğimi anlatabilmişim şimdi bu dediğinizi tüm sayfaya nasıl uygulayabilirim yukarıda ki örneğe ek olarak örneğin a2 hücresine "Şirket(örnek değer olarak belirttim)" yazıp c2;c3 ve d2;d3 hücreleri ve k2;k3 hücrelerini birleştirebilir miyiz. Bunu tüm çalışma sayfasına uygulamak istiyorum.

Şu şekilde formülize edebilir miyiz peki

tugkan · 8 Kasım 2024

Benim anladığım A2 hücresine herhangi bir şey yazıldığında C2,C3 ve D2,D3 ve K2,K3 hücreleri ayrı ayrı birleşecek. Doğru mu?

Tüm sayfaya uygulamak için belirli bir örüntü olması lazım. Ya bana örüntüyü söyleyeceksiniz ya da ayrı ayrı yazmanız lazım.

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Benim anladığım A2 hücresine herhangi bir şey yazıldığında C2,C3 ve D2,D3 ve K2,K3 hücreleri ayrı ayrı birleşecek. Doğru mu?

Tüm sayfaya uygulamak için belirli bir örüntü olması lazım. Ya bana örüntüyü söyleyeceksiniz ya da ayrı ayrı yazmanız lazım.

AYNEN DOĞRU ANLAMIŞSINIZ TUGKAN BEY BELİRLİ BİR ÖRÜNTÜ DERKEN HÜCRE ARALIĞINI MI KASTEDİYORSUNUZ YOKSA ÇALIŞMA SAYFASINI MI ?

tugkan · 8 Kasım 2024

Örüntüden kastım belirli bir düzen olması lazım. Mesela olayın belirli bir mantık veya kurala göre düzenlenmesiyle oluşan düzenli yapıdır.
Mesela A2'ye yazınca C2 ve C3 birleşsin.
A4'e yazınca C4ve C5 birleşsin.
A6'ya yazınca C6 ve C7 birleşsin ...gibi..
Belirli bir düzen olmasın lazım. bilmem anlatabildin mi?

Ya da kuralın işlemesini istediğiniz tüm hücreleri yazacaksınız ona göre tek tek tanımlayacağız.

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Örüntüden kastım belirli bir düzen olması lazım. Mesela olayın belirli bir mantık veya kurala göre düzenlenmesiyle oluşan düzenli yapıdır.
Mesela A2'ye yazınca C2 ve C3 birleşsin.
A4'e yazınca C4ve C5 birleşsin.
A6'ya yazınca C6 ve C7 birleşsin ...gibi..
Belirli bir düzen olmasın lazım. bilmem anlatabildin mi?

Ya da kuralın işlemesini istediğiniz tüm hücreleri yazacaksınız ona göre tek tek tanımlayacağız.

Evet anladım dediğinizi şu sekilde tarif edeyim bende, örnek a2 ye yazdığımızda C2,C3 ve D2,D3 ve K2,K3 hücreleri ayrı ayrı birleşecek ve bu örüntü aynı sizin de dediğiniz gibi a4'e de yazdığımızda da c4,c5 ve d4,d5 ve k4,k5 birleşmiş olacak ve diğer satırlarda değere bağlı olarak bu kurla devam edecek umarım bende anlatabilmişimdir teşekkür ederim.

tugkan · 8 Kasım 2024

Dener misiniz?

Güncel Kod

VBA modülünü açın:
- Alt + F11 tuşlarına basarak VBA editörünü açın.
Çalışma Sayfası Koduna Gitme:
- Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).
Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Sadece A sütununda değişiklik yapıldığında işlem yapılacak
    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Dim satirNo As Long
        satirNo = Target.Row
        
        ' A sütununa bir değer girildiğinde ilgili satırdaki hücreleri birleştir
        If Target.Value <> "" 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ütununa değer boş bırakılırsa 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
End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında A sütununda bir hücreye değer girildiğinde o satırdaki ilgili hücrelerin birleşmesini sağlar.
Örneğin, A2 hücresine herhangi bir değer girildiğinde:
- C2 ve C3 hücreleri birleşir.
- D2 ve D3 hücreleri birleşir.
- K2 ve K3 hücreleri birleşir.
A sütunundaki hücre boş bırakıldığında ise ilgili hücrelerin birleşimi kaldırılır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde, A sütununda her satır için belirttiğiniz hücre çiftleri (C-C, D-D ve K-K) ayrı ayrı birleşmiş olacak.

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Dener misiniz?

Güncel Kod

VBA modülünü açın:

Alt + F11 tuşlarına basarak VBA editörünü açın.

Çalışma Sayfası Koduna Gitme:

Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).

Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) ' Sadece A sütununda değişiklik yapıldığında işlem yapılacak If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then Dim satirNo As Long satirNo = Target.Row ' A sütununa bir değer girildiğinde ilgili satırdaki hücreleri birleştir If Target.Value <> "" 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ütununa değer boş bırakılırsa 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 End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında A sütununda bir hücreye değer girildiğinde o satırdaki ilgili hücrelerin birleşmesini sağlar.

Örneğin, A2 hücresine herhangi bir değer girildiğinde:

C2 ve C3 hücreleri birleşir.

D2 ve D3 hücreleri birleşir.

K2 ve K3 hücreleri birleşir.

A sütunundaki hücre boş bırakıldığında ise ilgili hücrelerin birleşimi kaldırılır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde, A sütununda her satır için belirttiğiniz hücre çiftleri (C-C, D-D ve K-K) ayrı ayrı birleşmiş olacak.

EVET TAM İSTEDİĞİM GİBİ OLMUŞ ELİNİZE SAĞLIK AMA BEN BUNU SAYFAMA UYGULADIĞIM VAKİT KOD ŞU ŞEKİLDE HATA VERDİ "AMBİGUOUS NAME DETECED :WORKSHEET _CHANGE

Teknoas · 8 Kasım 2024

tugkan' Alıntı:
Dener misiniz?

Güncel Kod

VBA modülünü açın:

Alt + F11 tuşlarına basarak VBA editörünü açın.

Çalışma Sayfası Koduna Gitme:

Sol taraftaki gezgin penceresinde, ilgili çalışma sayfanızın adına sağ tıklayıp Kod Görüntüleyi seçin (örneğin Sheet1).

Aşağıdaki VBA Kodunu Yapıştırın:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range) ' Sadece A sütununda değişiklik yapıldığında işlem yapılacak If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then Dim satirNo As Long satirNo = Target.Row ' A sütununa bir değer girildiğinde ilgili satırdaki hücreleri birleştir If Target.Value <> "" 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ütununa değer boş bırakılırsa 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 End Sub

4.Kodun Çalışması:

Bu kod, çalışma sayfasında A sütununda bir hücreye değer girildiğinde o satırdaki ilgili hücrelerin birleşmesini sağlar.

Örneğin, A2 hücresine herhangi bir değer girildiğinde:

C2 ve C3 hücreleri birleşir.

D2 ve D3 hücreleri birleşir.

K2 ve K3 hücreleri birleşir.

A sütunundaki hücre boş bırakıldığında ise ilgili hücrelerin birleşimi kaldırılır.

5.Kaydedip Çıkın:

Kod penceresini kapatın ve Excel dosyanızı kaydedin.

Bu şekilde, A sütununda her satır için belirttiğiniz hücre çiftleri (C-C, D-D ve K-K) ayrı ayrı birleşmiş olacak.

EVET TAM İSTEDİĞİM GİBİ OLMUŞ ELİNİZE SAĞLIK AMA BEN BUNU SAYFAMA UYGULADIĞIM VAKİT KOD ŞU ŞEKİLDE HATA VERDİ "AMBİGUOUS NAME DETECED :WORKSHEET _CHANGE

tugkan · 8 Kasım 2024

Bu hata, çalışma sayfasında birden fazla Worksheet_Change olayı olduğu anlamına gelir. Yani, aynı sayfada birden fazla Worksheet_Change alt yordamı bulunuyor ve bu durum VBA'nın hangisini çalıştırması gerektiğini bilememesine neden oluyor.

Worksheet_Change olayı, Excel VBA'da bir çalışma sayfasındaki hücrede herhangi bir değişiklik yapıldığında tetiklenen bir olaydır. Bu olay, bir hücreye veri girildiğinde, veri değiştirildiğinde veya bir hücre silindiğinde çalışır. Örneğin, kullanıcı bir hücreyi değiştirdiğinde, bu olayı kullanarak bazı işlemleri otomatik olarak gerçekleştirebilirsiniz.

Bu şekilde başka kodlar var ve bunlar çakışıyor.

Teknoas · 11 Kasım 2024

tugkan' Alıntı:
Bu hata, çalışma sayfasında birden fazla Worksheet_Change olayı olduğu anlamına gelir. Yani, aynı sayfada birden fazla Worksheet_Change alt yordamı bulunuyor ve bu durum VBA'nın hangisini çalıştırması gerektiğini bilememesine neden oluyor.

Worksheet_Change olayı, Excel VBA'da bir çalışma sayfasındaki hücrede herhangi bir değişiklik yapıldığında tetiklenen bir olaydır. Bu olay, bir hücreye veri girildiğinde, veri değiştirildiğinde veya bir hücre silindiğinde çalışır. Örneğin, kullanıcı bir hücreyi değiştirdiğinde, bu olayı kullanarak bazı işlemleri otomatik olarak gerçekleştirebilirsiniz.

Bu şekilde başka kodlar var ve bunlar çakışıyor.

Teşekkür ederim gayet anlaşılır bilgi veriyorsunuz.Peki çakışmaması için ne yapabilirim.Birde şartlı olarak biçimlendirmesi için kodu nasıl düzenleyebilirim.Yani hücrede ki değer bağlı olarak kod çalışsın istiyorum.Örnek "BİR"yazıyım ve biçimlendirme yapsın değilse yapmasın

tugkan · 11 Kasım 2024

Diğer Worksheet_Change olanların hepsini birleştirmek gerekiyor. Diğer worksheet change olan kodları da yazarsanız hepsini birleştirelim.

Hücre içerisine belirli kelimeler mi yazılacak yoksa herhangi bir şey mi?

Teknoas · 11 Kasım 2024

tugkan' Alıntı:
Diğer Worksheet_Change olanların hepsini birleştirmek gerekiyor. Diğer worksheet change olan kodları da yazarsanız hepsini birleştirelim.

Hücre içerisine belirli kelimeler mi yazılacak yoksa herhangi bir şey mi?

Diğer kodlarım bunlar;

Private Sub TextBox1_Change()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
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)
If Not Intersect(Target, Range("E1:E10000")) Is Nothing Then
Target.Copy
End If
End Sub

HÜCRE İÇİRESİNE YAZILACAK DEĞERİM "Şirket" olacak sadece şirket yazdığı zaman biçimlendirmeyi yapsın diğer türlü yapmasın.

tugkan · 11 Kasım 2024

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.