Soldan Ara Makro

[Utekiner]

Merhaba;

Makro ile nasıl yapılıyor. Yardımcı olabilir misiniz.

https://s4.dosya.tc/server7/9apc8r/Soldan_Ara.xlsm.html

Kısaca: Düşeyara/Eleman , İndis ve Kaçıncı fonksiyonları ile arayıp soldaki veriyi yazdırıyorum. Örnekte satır sayısı az ancak çok sayıdaki satırlarda formül donmalar ile karşılaşıyorum. Makro öğrenmeye yeni başladım. Makro kaydet yöntemi ile deneme yanılma yöntemiyle bir şeyler elde ediyoruz. Sizleri bu tarz ufak makroların nasıl yazıldığını görmek için konular açacağım. Şimdiden destekleriniz için teşekkür ederim. Kolaylıklar dilerim.

 

[YUSUF44]

Sayfaya veri girdikçe istediğiniz işlemin yapılması için aşağıdaki kodları ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) kopyalayıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
Set s1 = Sheets("Sheet1")
If Selection > 1 Then Exit Sub
If Target = "" Then Exit Sub
son = s1.Cells(Rows.Count, "C").End(3).Row
If WorksheetFunction.CountIf(s1.Range("C1:C" & son), Target) > 1 Then
    MsgBox "Girilen veri birden fazla kayıt içeriyor!", vbCritical
    Target.Select
    Exit Sub
ElseIf WorksheetFunction.CountIf(s1.Range("C1:C" & son), Target) = 0 Then
    MsgBox "Girilen veri bulunamadı!", vbCritical
    Target.Select
    Exit Sub
Else
    a = WorksheetFunction.Match(Target, s1.Range("C1:C" & son), 0)
    Target.Offset(0, 1) = s1.Cells(a, "A")
    Target.Offset(0, 2) = s1.Cells(a, "B")
End If
End Sub

Eğer mevcut verileriniz için bu işlemi yaptırmak istiyorsanız aşağıdaki kodları kullanabilirsiniz:

Sub kontrol()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")

son1 = s1.Cells(Rows.Count, "C").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row

For i = 2 To son2
    If WorksheetFunction.CountIf(s1.Range("C1:C" & son1), s2.Cells(i, "A")) > 1 Then
        s2.Cells(i, "D") = "Birden fazla kayıt"
    ElseIf WorksheetFunction.CountIf(s1.Range("C1:C" & son1), s2.Cells(i, "A")) = 0 Then
        s2.Cells(i, "D") = "Kayıt yok"
    Else
        a = WorksheetFunction.Match(s2.Cells(i, "A"), s1.Range("C1:C" & son1), 0)
        s2.Cells(i, "B") = s1.Cells(a, "A")
        s2.Cells(i, "C") = s1.Cells(a, "B")
    End If
Next
End Sub

 

[Utekiner]

@YUSUF44 Hocam süpersin eline sağlık teşekkür ederim.