Aynı Sayfada iki Worksheet_SelectionChange(ByVal Target As Range) kullanma

Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Merhaba Arkadaşlar,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
bb = [b65536].End(3).Row
aa = [D65536].End(3).Row
If Intersect(Target, [G1:G5]) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
For i = aa + 1 To bb
Cells(i, "d") = Target
Next i
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
bb = [b65536].End(3).Row
aa = [C65536].End(3).Row
If Intersect(Target, [F1:F5]) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
For i = aa + 1 To bb
Cells(i, "c") = Target
Next i
Application.ScreenUpdating = True
End Sub

Yukarıdaki kodları aynı sayfada nasıl kullanabilirim. Yardımlarınız için şimdiden teşekkür ederim.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba

Bu şekilde olabilir. ( Deneme yapmadım.)
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
bb = [b65536].End(3).Row
aa = [D65536].End(3).Row
If Intersect(Target, [F1:G5]) Is Nothing Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
If Target.Column = 6 Then
    For i = aa + 1 To bb
    Cells(i, "c") = Target
    Next i
End If
If Target.Column = 7 Then
    For i = aa + 1 To bb
    Cells(i, "d") = Target
    Next i
End If
Application.ScreenUpdating = True
End Sub
 
Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Ömer Hocam,
İlginiz için çok teşekkür ederim. Kod maalesef çalışmadı.
 

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Mantık olarak çalışması gerekirdi.
Örnek dosya ekleyerek açıklayınız.
 
Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Ömer Hocam,
Özür dilerim. C ve D sütunu boşken gayet güzel çalışıyor. Yalnız ilave etmeyi unutmuşum C ve D sütunları doluyken 2. tıklama da değiştirmiyor. Acaba C ve D sütunları doluyken de çalıştırmak mümkün mü?
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Yapmak istediğiniz nedir?
Kodlardan çözmeye çalışırım fakat hatalı dediğiniz için, eski kodları hesaba katmadan yapmak istediğinizi en başından detaylı açıklar mısınız.
 
Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Ömer Hocam,
Örnek dosya üzerinden açıklamaya çalışacağım. F2 hücresine tıkladım, C2:C7aralığına 510 yazdı. G5 hücresine tıkladım, D2:D7aralığına 570 yazdı. Tekrar C2:C7 ve D2:D7 aralığını silmeden F4 hücresine tıkladığımda C2:C7 aralığına nasıl 570 yazdırabilirim veya G1 hücresine tıkladığımda D2:D7 aralığına 480 yazdırabilirim?
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,196
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Deneyiniz.
Yalnız 7 olan satır değerini A sütunundaki son satıra göre alıyorsunuz sanırım. O şekilde yaptım, değilse düzeltebilirsiniz.
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim son As Long
    If Intersect(Target, [F1:G5]) Is Nothing Then Exit Sub
    son = Cells(Rows.Count, "A").End(3).Row - 1
    Application.ScreenUpdating = False
    If Target.Column = 6 Then
        Range("C2:C" & Rows.Count).ClearContents
        If son < 1 Then Exit Sub
        Range("C2").Resize(son, 1) = Target
    End If
    If Target.Column = 7 Then
        Range("D2:D" & Rows.Count).ClearContents
        If son < 1 Then Exit Sub
        Range("D2").Resize(son, 1) = Target
    End If
    Application.ScreenUpdating = True
End Sub
 
Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
Ömer Hocam,
Yardımlarınız için çok teşekkür ederim.
 
Üst