• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

2 change olayını birleştirme

Katılım
2 Mart 2009
Mesajlar
44
Excel Vers. ve Dili
office 07
arkadaşlar merhaba elimde ayrı ayrı çalışan iki change olayı bunları birleştirip tek sayfada uygulamak istiyorum ancak ne ettiycem ya biri çalışıyor yada öteki
yardım ederseniz sevinirim. Şimdiden teşekkürler...

1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("g22820:g65000")) Is Nothing Then
On Error Resume Next
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("2015-2").Range("q:q"), Cells(Target.Row, "g")) > 0 Then
Cells(Target.Row, "h") = WorksheetFunction.VLookup(Cells(Target.Row, "g"), Sheets("2015-2").Range("q2:r45"), 2, 0)
Else
Cells(Target.Row, "h") = "yoK"
End If
End If


2.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If Target.Cells.Count = 1 Then
If Target.Value = "" Then
Target.Offset(0, -3) = ""
Target.Offset(0, -2) = ""
Else
Target.Offset(0, -3) = Format(Date, "dd.mm.yyyy")
Target.Offset(0, -2) = Format(Now, "hh:mm")
End If
Else
For Each Veri In Selection
If Veri.Column = 6 Then
If Veri.Value = "" Then
Veri.Offset(0, -3) = ""
Veri.Offset(0, -2) = ""
Else
Veri.Offset(0, -3) = Format(Date, "dd.mm.yyyy")
Veri.Offset(0, -2) = Format(Now, "hh:mm")
End If
End If
Next
End If

End Sub
 
Aşağıdaki şekilde deneyin. Mantık şöyle : ilk şartımızı yani range/target belirleyince exit sub değil de bir satır belirtip oraya yönlendiriyoruz. Örnekte goto 10 olarak belirttiğim gibi yani. İkinci şartı ise normal olarak exit sub ile bitiriyoruz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("g22820:g65000")) Is Nothing Then goto 10
On Error Resume Next
If Target = "" Then Exit Sub
If WorksheetFunction.CountIf(Sheets("2015-2").Range("q:q"), Cells(Target.Row, "g")) > 0 Then
Cells(Target.Row, "h") = WorksheetFunction.VLookup(Cells(Target.Row, "g"), Sheets("2015-2").Range("q2:r45"), 2, 0)
Else
Cells(Target.Row, "h") = "yoK"
End If



10:

If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If Target.Cells.Count = 1 Then
If Target.Value = "" Then
Target.Offset(0, -3) = ""
Target.Offset(0, -2) = ""
Else
Target.Offset(0, -3) = Format(Date, "dd.mm.yyyy")
Target.Offset(0, -2) = Format(Now, "hh:mm")
End If
Else
For Each Veri In Selection
If Veri.Column = 6 Then
If Veri.Value = "" Then
Veri.Offset(0, -3) = ""
Veri.Offset(0, -2) = ""
Else
Veri.Offset(0, -3) = Format(Date, "dd.mm.yyyy")
Veri.Offset(0, -2) = Format(Now, "hh:mm")
End If
End If
Next
End If

End Sub
 
Target, o anda seçili olan daha doğrusu değişiklik yapıan hücre demek. Target'i

If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub

satırıyla önce belirliyoruz. Eğer F sütununda bir hücrede değişiklik yapılırsa sonraki kodları çalıştırıyoruz.

Target.offset(0,-3) ise değişiklik olan hücreden 3 sütun önceki hücre oluyor.
 
Geri
Üst