sayfalar arası hesap toplatma

[limanC34]

Selam Arkadaşlar
Örnek dosyada kişiye ait bilgilerden herhangi birisi ilgili textboxa yazılınca 1987 ile 1995 arası bilgiler BİLGİ sayfasındaki yerlerine getirilebilir mi?
Teşekkürler.

 

[Ayhan Ercan]

Merhaba Sayın limanC34

Aşağıdaki kodu bir düğmeye atayarak deneyiniz..

Sub sayfayaaktar()
Dim tc As Long, hcr As Range
tc = Sayfa1.TextBox4.Value
    For i = 2 To Sheets.Count
        Set hcr = Sheets(i).Range("Q11:Q" & Sheets(i).[Q65536].End(3).Row).Find(tc, lookat:=xlWhole)
        Sayfa1.Cells(i + 7, 2).Value = hcr.Offset(0, -1).Value
        Sayfa1.Cells(18, 2) = WorksheetFunction.Sum(Sayfa1.Range("B9:B17"))
        Set hcr = Nothing
    Next
End Sub

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz. Bütün arama kriterlerini yazdığınızda toplamlar gelecektir.

 

[limanC34]

sayfalar arası hesap

Sayın Ayhan Ercan ve Korhan Ayhan
Değerli çözümleriniz için teşekkürler.
Lakin Ayhan Bey'in kodlarını butona atayamadığımdan olsa gerek olmadı Korhan Bey'in çözümü tamam ama sadece TC no girildiğindede döküm alınabilir mi?
Saygılarımla.

 

[Ayhan Ercan]

Tc Kimlik Noyu kriter belleyerek aktarma...
Ek dosyayı İnceleyiniz...

Sub Düğme7_Tıklat()
Dim tc As Long, hcr As Range
tc = Sayfa1.TextBox4.Value
    For i = 2 To Sheets.Count
        Set hcr = Sheets(i).Range("Q11:Q" & Sheets(i).[Q65536].End(3).Row).Find(tc, lookat:=xlWhole)
        If Not hcr Is Nothing Then
        Sayfa1.Cells(i + 7, 2).Value = hcr.Offset(0, -1).Value
        Sayfa1.Cells(18, 2) = WorksheetFunction.Sum(Sayfa1.Range("B9:B17"))
        Else
        MsgBox "Belirttiğiniz Tc Kimlik No ile Herhangi bir Kayıt Bulunmamaktadır.": Exit Sub
        End If
    Next
        Sayfa1.Cells(5, 2) = hcr.Offset(0, -15)
        Sayfa1.Cells(6, 2) = hcr.Offset(0, -14)
        Sayfa1.Cells(7, 2) = hcr.Offset(0, -16)
        Sayfa1.Cells(8, 2) = hcr.Offset(0, 0)
        Sayfa1.TextBox1 = Sayfa1.Cells(7, 2)
        Sayfa1.TextBox2 = Sayfa1.Cells(5, 2)
        Sayfa1.TextBox3 = Sayfa1.Cells(6, 2)
    Set hcr = Nothing
    MsgBox "Aktarma İşlemi Tamamlanmıştır!", vbInformation, "BİLGİ"
End Sub

 

[limanC34]

Sayın Ayhan Ercan
Sabırınızla yaptığınız çözümünüz için çok teşekkür ederim.
Saygılarımla.