Tarih ile veri çağırma

[nadirornek]

İki tane döngü koduna ihtiyacım vardır.

1.kod Sayfa1'in I1 hücresine tarih girdiğim zaman o tarihe karşılık gelen verileri Sayfa2'nin C sutununu bakarak 16 veriyi K sutununundan almasını istiyorum.

2.kod Sayfa1'in B5 hücresine bir numara girdiğimde numaranın devamını Sayfa2'nin K sutununu bakarak alt alta 16 verinin getirilmesini istemekteyim.

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırırsanız 1. sorunuz çözülür. Ancak ikinci sorunuzu anlamadım. numaranın devamından ne kastettiğinizi daha açık belirtirseniz ilgilenmeye çalışırım:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")
son1 = WorksheetFunction.Max(5, Cells(Rows.Count, "B").End(3).Row)
Range("B5:B" & son1).ClearContents

son2 = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "C").End(3).Row)
    yeni = 5
For i = 2 To son2
    If s2.Cells(i, "C") = Target Then
    Cells(yeni, "B") = s2.Cells(i, "K")
    yeni = yeni + 1
    End If
Next
Application.EnableEvents = True
End Sub

 

[nadirornek]

2. kod için B5 hücresine girdiğim numara sayfa2'nin K sutununa bakarak ondan sonra gelen verilerin alt alta yazdırılması
Tarihe bakmadan verilerin getirilmesi

 

[nadirornek]

1.kod için teşekkürler güzel çalışıyor

 

[YUSUF44]

Anladığım kadarıyla şöyle olacak:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("I1")) Is Nothing Then GoTo 10
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")
son1 = WorksheetFunction.Max(5, Cells(Rows.Count, "B").End(3).Row)
Range("B5:B" & son1).ClearContents

son2 = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "C").End(3).Row)
    yeni1 = 5
For i = 2 To son2
    If s2.Cells(i, "C") = Target Then
    Cells(yeni1, "B") = s2.Cells(i, "K")
    yeni1 = yeni1 + 1
    End If
Next
Application.EnableEvents = True
10
If Intersect(Target, Range("B5")) Is Nothing Then Exit Sub
Application.EnableEvents = False
son3 = WorksheetFunction.Max(6, Cells(Rows.Count, "B").End(3).Row)
Range("B6:B" & son3).ClearContents
Set s3 = Sheets("Sayfa2")
son4 = WorksheetFunction.Max(2, s3.Cells(Rows.Count, "K").End(3).Row)
    yeni2 = 6
For j = 2 To son4
    If s3.Cells(j, "K") = Target Then
    For k = j + 1 To son4
        Cells(yeni2, "B") = s3.Cells(k, "K")
    yeni2 = yeni2 + 1
    Next
    j = son4
    End If
Next
Application.EnableEvents = True
End Sub

Eğer olur da yukardaki kodlar çalışırken hata verirse sayfa olayları çalışmayacağından, normale döndürmek için aşağıdaki kodu çalıştırmanız gerekir:

Sub aktif()
Application.EnableEvents = True

End Sub

 

[nadirornek]

Private Sub Worksheet_Change(ByVal Target As Range)

Kodun bu satırında
Compile error:
Ambiguous name detected:Worksheer_Change

Hata veriyor.

Sub aktif()
Application.EnableEvents = True

End Sub
Bu kod aktif yapmıyor.

 

[YUSUF44]

Worksheet mi Worksheer mi?

Ben kodu deneyerek hazırlamıştım.

 

[nadirornek]

1.kodu silince düzeldi kod çalışıyor.Teşekkürler