Data sekmesinden kritere göre veri almak

[ÖzHelldorad0]

Arkadaşlar merhaba, büyük ihtimalle basit bir operasyon fakat netten bulamadım bi türlü. Ekte yolladığım dosyada yapmaya çalıştığım durum şudur, yardımlarınızı rica ediyorum;

-DATA ve HEDEF diye 2 sekme var,
-HEDEF sekmesindeki butona basılacak,
-Kişilerin TC kimlik numarasına göre ("DATA" da) arama yapacak,
-Bulduklarını HEDEF sekmesindeki adı soyadı ve TC si sabit olan kişilere yazacak,

Not: HEDEF sekmesinde sabit isimler ve TC no ları var. TC no suna göre DATA dan veri alcak.

Teşekkürler!

 

[dellerlim]

Merhaba.
Sadece 1 T.C. için düzenledim, isterseniz arttırabilirsiniz. Butona tıklayınca veya T.C. No'yu yazıp o hücreden çıkınca çalışır makro.

 

[ÖzHelldorad0]

Sn.dellerlim, ellerinize sağlık çok teşekkür ederim tek satırı anladım. Fakat data sekmesindeki satır sayısını artırmak için ne yapılacağını çözemedim..

-mesela, satırı 1 artırıcam, for i = 5 to 10 'dan sonra ne şekilde devam edebilirim ?

 

[Ömer BARAN]

Merhaba.

1) HEDEF sayfasında yeni satır eklemeyip sadece mevcut TC kimlik numaralırana göre bilgileri getirecekseniz;
-- Alt taraftan HEDEF sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kod blokunu yapıştırın,
-- sayfaya bir adet Metin Kutusu/Şekil/Düğme ekleyin,
-- bu şekil/metin kutusu/düğmeye fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- açılan küçük ekranda DATADAN_AL'ı seçerek işlemi onaylayın,
Artık eklediğiniz şekil/metin kutusu/düğmeye tıkladığınızda DATA sayfasındaki veriler TC kimlik kriterine göre sayfaya yazılacaktır.
.

[B][COLOR="Red"]Sub DATADAN_AL()[/COLOR][/B]
Set d = Sheets("DATA")
Set h = Sheets("HEDEF")
Set wf = Application.WorksheetFunction
aramayeri = "C5:C" & d.Cells(Rows.Count, "C").End(xlUp).Row

For hsat = 5 To h.Cells(Rows.Count, "D").End(xlUp).Row
    If wf.CountIf(d.Range(aramayeri), h.Cells(hsat, "D")) > 0 Then
        dsat = wf.Match(h.Cells(hsat, "D"), d.Range(aramayeri), 0) + 4
        d.Range(d.Cells(dsat, "D"), d.Cells(dsat, "F")).Copy h.Cells(hsat, "E")
        h.Cells(hsat, "H") = wf.MRound(d.Cells(dsat, "F"), 5)
        h.Cells(hsat, "I") = wf.Sum(h.Cells(hsat, "F") + h.Cells(hsat, "G"))
    Else
        h.Range(Cells(hsat, "E"), Cells(hsat, "I")).ClearContents
    End If
Next
MsgBox "İşlem tamamlandı!..", vbInformation, "..::.. Ömer BARAN ..::.."
[B][COLOR="red"]End Sub[/COLOR][/B]

2) HEDEF sayfasına yeni TC kimlik numaraları yazıp, bunları yazdıkça o TC kimlik numarasına ait verileri getirmek istiyorsanız;
-- Alt taraftan HEDEF sayfasının adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki boş alana aşağıdaki kodu yapıştırın,
Artık siz TC yazdıkça veriler gelecektir.
.

[B][COLOR="red"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]

If Target.Column <> 4 Then Exit Sub
Set d = Sheets("DATA")
Set wf = Application.WorksheetFunction
alan = "D5:D" & Cells(Rows.Count, "D").End(xlUp).Row
If Intersect(Target, Range(alan)) Is Nothing Then Exit Sub
    If Target = "" Or wf.CountIf(d.Range("C:C"), Target) = 0 Then
        Range(Cells(Target.Row, "E"), Cells(Target.Row, "I")).ClearContents
    Else
        dsat = wf.Match(Target, d.Range("C:C"), 0)
        d.Range(d.Cells(dsat, "D"), d.Cells(dsat, "F")).Copy Cells(Target.Row, "E")
        Cells(Target.Row, "H") = wf.MRound(d.Cells(dsat, "F"), 5)
        Cells(Target.Row, "I") = wf.Sum(Cells(Target.Row, "F") + Cells(Target.Row, "H"))
    End If

[B][COLOR="red"]End Sub[/COLOR][/B]

NOT: Her iki seçenek için de veri alanının kaç satırdan oluştuğu kodlar tarafından tespit edilecektir,
yani sizin kod'da bir değişiklik yapmanıza lüzum yok.
.

 

[ÖzHelldorad0]

Sn.Ömer, bomba gibi oldu. Çok teşekkürler !