2 Listeyi Karşılaştırma

[Trilenium]

Merhaba,

Aşırı yorgunluktan olsa gerek, yazdığım kodda hata yapıyorum.

Data adlı bir sheetim var, bu sheette bulunan tarihleri, Veri adlı sheetin A kolonunda yer alan tarihler ile aratmak istiyorum.

Eğer aradığı tarihi bulur ise data adlı sheette bulduğu tarihin karşısında yazan sayıyı Data adlı sheette B kolonuna yazsın

Eğer bulamaz ise Data adlı sheetin B kolonuna 1 yazsın.

Sanırım uykusuzluktan dünyanın en basit döngüsünü kaçırıyorum.


Teşekkürler

 

[Ziynettin]

Bu şekilde deneyiniz.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Veri")
Set s2 = Sheets("Data")
Set dc = CreateObject("scripting.dictionary")
a = s1.Range("A2:B" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 1 To UBound(a)
        dc(CStr(a(i, 1))) = a(i, 2)
    Next i
a = s2.Range("A2:A" & s2.Cells(Rows.Count, 1).End(3).Row).Value
    For i = 1 To UBound(a)
        krt = CStr(a(i, 1))
        If dc.exists(krt) Then
            a(i, 1) = dc(krt)
        Else
            a(i, 1) = 1
        End If
    Next i
s2.[B2].Resize(UBound(a)) = a
End Sub

 

[EmrExcel16]

Alternatif olarak .

Private Sub CommandButton1_Click()
    Dim i, bul, firstAddress
    Application.ScreenUpdating = False
    For i = 2 To Sheets("Data").Range("A65536").End(3).Row
        Set bul = Sheets("veri").Range("A1:A100000").Find(Sheets("Data").Cells(i, "A"), , xlValues, xlWhole)
        If Not bul Is Nothing Then
            firstAddress = bul.Address
            Do
                Sheets("Data").Range("B" & i).Value = Sheets("Data").Range("B" & i).Value + Sheets("Veri").Range("B" & bul.Row).Value
                Set bul = Sheets("veri").Range("A1:A100000").FindNext(bul)
            Loop While Not bul Is Nothing And bul.Address <> firstAddress
        Else
            Sheets("Data").Range("B" & i).Value = "1"
        End If
    Next
    Application.ScreenUpdating = True
End Sub