sayfa 1 deki tarihe tıklayınca sayfa 2 deki ilişkili verileri çekme ?

[blackkugu]

sayfa 1 deki tarihe tıklayınca sayfa 2 deki tarihe denk gelen verileri sayfa 1 deki ilgili konu başlığa göre listeleme yapmak istiyorum fakat nasıl bağlantı kuracağımı şaşırdım.
sayfa 1

sayfa 2 görseli

görselleri ekledim.

 

[Necdet]

Merhaba,

dosya.tc, dosya.co gibi paylaşım sitelerinden birinde basit örnek dosyanızı eklerseniz kod yazacak olan kişi için veri hazırlama derdinden kurtarırsınız.

 

[blackkugu]

İndir sayfalar arası arama

Dosyayı indir sayfalar arası arama

dosya.co

dosya ekte arkadaşlar fare ile ilgili alanı tarayabiliyorum. gerisini getiremedim kodlarıda sildim.

 

[Necdet]

Merhaba,
Aşağıdaki kodlar Sayfa1'in kod bölümünde olmalı.
Birşeyler yaptım ama büyük olasılıkla olmadı diyeceksiniz, zaten mantıklı bir durum gibi gelmedi bana açıklamanız.
Yinede deneyin derim.

Sayfa1 deki B sütunundaki tarihe Çift Tıklarsanız o tarihe denk gelen ay ve yıla ait veriyi Sayfa2 de arar ve listeler.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Then Exit Sub
    
    Dim i   As Long, _
        j   As Integer, _
        Kol As Integer, _
        Sat As Long, _
        Drm As Boolean
    
    Sayfa1.Range("E4").CurrentRegion.Offset(1).ClearContents
    
    For j = 1 To 3
        If j = 1 Then
            Kol = 2
        ElseIf j = 2 Then
            Kol = 5
        Else
            Kol = 8
        End If
            
        Sat = 2
        Drm = False
        
        Do Until Sayfa2.Cells(Sat, Kol) = "" Or Drm = True
            If Format(Target.Value, "yyyymm") = Format(Sayfa2.Cells(Sat, Kol), "yyyymm") Then
                Drm = True
                Sayfa1.Cells(Target.Row, 4 + j) = Sayfa2.Cells(Sat, Kol + 1)
            End If
            Sat = Sat + 1
        Loop
        
    Next j
    
    MsgBox "Bitti...."
    
End Sub

 

[blackkugu]

Merhaba,
Aşağıdaki kodlar Sayfa1'in kod bölümünde olmalı.
Birşeyler yaptım ama büyük olasılıkla olmadı diyeceksiniz, zaten mantıklı bir durum gibi gelmedi bana açıklamanız.
Yinede deneyin derim.

Sayfa1 deki B sütunundaki tarihe Çift Tıklarsanız o tarihe denk gelen ay ve yıla ait veriyi Sayfa2 de arar ve listeler.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Then Exit Sub
   
    Dim i   As Long, _
        j   As Integer, _
        Kol As Integer, _
        Sat As Long, _
        Drm As Boolean
   
    Sayfa1.Range("E4").CurrentRegion.Offset(1).ClearContents
   
    For j = 1 To 3
        If j = 1 Then
            Kol = 2
        ElseIf j = 2 Then
            Kol = 5
        Else
            Kol = 8
        End If
           
        Sat = 2
        Drm = False
       
        Do Until Sayfa2.Cells(Sat, Kol) = "" Or Drm = True
            If Format(Target.Value, "yyyymm") = Format(Sayfa2.Cells(Sat, Kol), "yyyymm") Then
                Drm = True
                Sayfa1.Cells(Target.Row, 4 + j) = Sayfa2.Cells(Sat, Kol + 1)
            End If
            Sat = Sat + 1
        Loop
       
    Next j
   
    MsgBox "Bitti...."
   
End Sub

sayfa 1 de örneğin 01/01/2022 tarihine çift tıkladığımda
sayfa 2 deki A sutununda kaç adet aynı tarih varsa altına dizsin aynı şekilde B ve C başlıkların altına dizsin
farklı bir tarihe çift tıkladığımda tıklananın yanına değilde eski gelen veriyi silip tekrar A,B,C başlıkların altında listelesin.

kodlamada arama yaparken sanırım sadece yıl ve ay eklenmiş bende günü ekledim "yyyymmdd" bu şekilde aramada sıkıntı yokta yukarıdaki gibi aşağıya doğru her çift tıklamadan gelen veriyi konu başlığın altından itibaren listelesin.

 

[blackkugu]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Then Exit Sub
Dim i As Integer
Dim j As Integer
Dim Sayac As Integer
Dim SinananVeri As String
Veri = Target.Value
SinananVeri = Veri
Set Say1 = Worksheets("Sayfa1")
Set Say2 = Worksheets("Sayfa2")
j = 1
For i = 1 To 10

If Format(SinananVeri, "yyyymmdd") = Format(Sayfa2.Cells(i, 2), "yyyymmdd") Then
MsgBox Say2.Cells(i, 2)
Say1.Cells(j, 1) = Say2.Cells(i, 2)
Sayac = Sayac + 1
j = j + 1
End If
Next i
MsgBox Say2.Name & "'de aramış olduğunuz " & Veri & " verisini içeren toplam " & Sayac & " adet hücre değeri bulundu ve " & Say1.Name & "'de listelendi."


End Sub

sonunda yaptım belki birilerine yarar sayfa 1 deki veriye çift tıklayarak sayfa 2 deki verileri arayarak tekrar sayfa 1 e yazdırıyoruz.

 

[Necdet]

Merhaba,

Bire bir tarih kontrolü yapıyorsanız :
If Format(SinananVeri, "yyyymmdd") = Format(Sayfa2.Cells(i, 2), "yyyymmdd") Then
satırını formatlamadan kullanabilirsiniz.
If SinananVeri = Sayfa2.Cells(i, 2) Then
olarak.

 

[blackkugu]

tşk ederim.

 

[Necdet]

Merhaba,
Sorunuzu çözdüğünüzü söylüyorsunuza ama, sorduğunuzla çözüm aynı değil.
Siz sadece sayfa2 nin B sütununda arıyorsunuz ve sadece sayfa1'in A sütununa yazdırıyorsunuz.

Oysa aranacak 3 sütun ve yazılacak 3 sütun var.

Ayrıca ben kodlarrda Sayfa2.Cells(i,2) olarak kullandığım sizin yaptığınızda Say2.Cells(i, 2) ile aynı. Siz ikisini birden kullanmışsınız, buna gerek yok.
Benim kullandığım yöntemde (ki ben sayfa indisini kullanıyorum) kullanıcı sayfa adını değiştirse bile çalışacaktır, pratik yöntem yani.

 

[blackkugu]

Merhaba,
Sorunuzu çözdüğünüzü söylüyorsunuza ama, sorduğunuzla çözüm aynı değil.
Siz sadece sayfa2 nin B sütununda arıyorsunuz ve sadece sayfa1'in A sütununa yazdırıyorsunuz.

Oysa aranacak 3 sütun ve yazılacak 3 sütun var.

Ayrıca ben kodlarrda Sayfa2.Cells(i,2) olarak kullandığım sizin yaptığınızda Say2.Cells(i, 2) ile aynı. Siz ikisini birden kullanmışsınız, buna gerek yok.
Benim kullandığım yöntemde (ki ben sayfa indisini kullanıyorum) kullanıcı sayfa adını değiştirse bile çalışacaktır, pratik yöntem yani.

a sutunun daki aynı kodu b ve c içinde kopyalama yapacağım toplam verim 30 yi geçmez o yüzden diğer sutunlarıda rahatlıkla a daki gibi yapabilirim.
Say1.Cells(j, 1) = Say2.Cells(i, 2) diğeri i değil j harfi karıştırdınız. Yoksa benim beynim çok yoruldu sanırım göremedim.

 

[Necdet]

Range.Find komutu çalışmadı, sanırım formülle tarih getirdiğiniz için olsa gerek.
Klasik döngü ile ilk mesajdaki isteğe göre düzenlenmiş hali :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or IsDate(Target.Value) = False Then Exit Sub

Dim i   As Integer, _
    j   As Long, _
    r   As Long, _
    kol As Integer, _
    arr As Variant, _
    adt As Integer
    
Application.ScreenUpdating = True
Sayfa1.Range("E4").CurrentRegion.Offset(1).ClearContents

arr = Array(0, 2, 5, 8)
    
For i = 1 To 3

    kol = arr(i)
    r = 4

    For j = 2 To Sayfa2.Cells(Rows.Count, kol).End(3).Row
        If Sayfa2.Cells(j, kol) = Target.Value Then
            r = r + 1
            adt = adt + 1
            Sayfa1.Cells(r, i + 4) = Target.Value
        End If
    Next j
Next i

MsgBox Target.Value & " Tarihine Ait " & adt & " Kayıt Bulunmuştur....", vbInformation
Application.ScreenUpdating = False
 
End Sub

 

[blackkugu]

Range.Find komutu çalışmadı, sanırım formülle tarih getirdiğiniz için olsa gerek.
Klasik döngü ile ilk mesajdaki isteğe göre düzenlenmiş hali :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, [B:B]) Is Nothing Or Target.Row < 5 Or IsDate(Target.Value) = False Then Exit Sub

Dim i   As Integer, _
    j   As Long, _
    r   As Long, _
    kol As Integer, _
    arr As Variant, _
    adt As Integer
   
Application.ScreenUpdating = True
Sayfa1.Range("E4").CurrentRegion.Offset(1).ClearContents

arr = Array(0, 2, 5, 8)
   
For i = 1 To 3

    kol = arr(i)
    r = 4

    For j = 2 To Sayfa2.Cells(Rows.Count, kol).End(3).Row
        If Sayfa2.Cells(j, kol) = Target.Value Then
            r = r + 1
            adt = adt + 1
            Sayfa1.Cells(r, i + 4) = Target.Value
        End If
    Next j
Next i

MsgBox Target.Value & " Tarihine Ait " & adt & " Kayıt Bulunmuştur....", vbInformation
Application.ScreenUpdating = False

End Sub

emeğine sağlık hocam çok sağolun