2. ifli döngüye nasıl gider?

[janvaljan85]

Merhaba Üstadlar,

Birkaç gündür bu foruma üyeyim ve takip ediyorum. Kısa zamanda makro yazmaya bile başladım. Ancak aşağıdaki gibi bir makroda bence zor ama sizin için kolay bir sorunla karşılaştım. Sarıyla gösterilen yerde sorun veriyor. Sanırım o satırın sonuna

is nothing -- ikinci if'li döngüye git- yazmam gerekiyor.

Yardımcı olursanız sevinirim. Şimdiden teşekkürler

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [C33]) Then
Dim s1 As Worksheet
Dim i As Long
Dim c As Range
Dim Adr As String

Set s1 = Sheets("Index")
Range("B101:S500").ClearContents
i = 100
With s1.Range("d:d")
Set c = .Find(Target.Value, LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
i = i + 1
Cells(i, "B") = s1.Cells(c.Row, "F")
Cells(i, "C") = s1.Cells(c.Row, "G")
Cells(i, "D") = s1.Cells(c.Row, "H")
Cells(i, "E") = s1.Cells(c.Row, "IV")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Else

If Intersect(Target, [C33]) Is Nothing Then Exit Sub

Dim s11 As Worksheet
Dim ii As Long
Dim cc As Range
Dim Adrr As String

Set s11 = Sheets("Index")
Range("u113:x360").ClearContents
ii = 112
With s11.Range("g:g")
Set cc = .Find(Target.Value, LookIn:=xlValues)
If Not cc Is Nothing Then
Adrr = cc.Address
Do
ii = ii + 1
Cells(ii, "U") = s11.Cells(cc.Row, "F")
Cells(ii, "V") = s11.Cells(cc.Row, "G")
Cells(ii, "w") = s11.Cells(cc.Row, "H")
Cells(ii, "x") = s11.Cells(cc.Row, "IV")
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> Adrr




End If
End With
End If

End Sub

 

[janvaljan85]

Arkadaşlar yardımcı olacak birisi yok mu? Target hücreler farklı 2 hücreyse bunu nasıl yapabilirim? Sanırım sorun bununla ilgili.

İlkinde C33 2.sinde J33 değiştirilecek. Bunlar farklı değerler ve 2 değer birbirinden bağımsız olarak değişirse farklı tablolarda değişiklikler oluşturabilir.

Yardımınızı bekliyorum..

 

[halit3]

Arkadaşlar yardımcı olacak birisi yok mu? Target hücreler farklı 2 hücreyse bunu nasıl yapabilirim? Sanırım sorun bununla ilgili.

İlkinde C33 2.sinde J33 değiştirilecek. Bunlar farklı değerler ve 2 değer birbirinden bağımsız olarak değişirse farklı tablolarda değişiklikler oluşturabilir.

Yardımınızı bekliyorum..

böyle denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "C33" Then
Dim s1 As Worksheet
Dim i As Long
Dim c As Range
Dim Adr As String
Set s1 = Sheets("Index")
Range("B101:S500").ClearContents
i = 100
With s1.Range("d:d")
Set c = .Find(Target.Value, LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
i = i + 1
Cells(i, "B") = s1.Cells(c.Row, "F")
Cells(i, "C") = s1.Cells(c.Row, "G")
Cells(i, "D") = s1.Cells(c.Row, "H")
Cells(i, "E") = s1.Cells(c.Row, "IV")
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Else
'If Intersect(Target, [C33]) Is Nothing Then Exit Sub
Dim s11 As Worksheet
Dim ii As Long
Dim cc As Range
Dim Adrr As String
Set s11 = Sheets("Index")
Range("u113360").ClearContents
ii = 112
With s11.Range("g:g")
Set cc = .Find(Target.Value, LookIn:=xlValues)
If Not cc Is Nothing Then
Adrr = cc.Address
Do
ii = ii + 1
Cells(ii, "U") = s11.Cells(cc.Row, "F")
Cells(ii, "V") = s11.Cells(cc.Row, "G")
Cells(ii, "w") = s11.Cells(cc.Row, "H")
Cells(ii, "x") = s11.Cells(cc.Row, "IV")
Set cc = .FindNext(cc)
Loop While Not cc Is Nothing And cc.Address <> Adrr
End If
End With
End If
End Sub