Kategori Haricindekileri Listeleme

Kod:
Option Compare Text



Sub Bul()



    Dim son As Long, i As Long, say As Long, arr

    Dim sVeri As Worksheet: Set sVeri = Sheets("Veri")

    Dim sKategoriListesi As Worksheet: Set sKategoriListesi = Sheets("KategoriListesi")

    Dim sSonuc As Worksheet: Set sSonuc = Sheets("Sonuc")

    

    With sVeri

        son = .Cells(Rows.Count, "F").End(3).Row

        ReDim arr(1 To son, 1 To 2)

        say = 0

        With sSonuc

            .Range("A2:B" & Rows.Count).ClearContents

            .Range("A1").Value = "NO"

            .Range("B1").Value = "SONUCLAR"

        End With

        On Error Resume Next

        For i = 12 To son

            If WorksheetFunction.Match(.Cells(i, "F").Value, sKategoriListesi.Range("L:L"), 0) = 0 Then

                say = say + 1

                arr(say, 1) = say

                arr(say, 2) = .Cells(i, "F").Value

            End If

        Next

        

        sSonuc.Range("A2").Resize(say, 2).Value = arr

        Application.ScreenUpdating = True

    End With

    

    MsgBox "Bitti", vbInformation, "Bilgi"

    On Error Resume Next

    Erase arr

    Set sVeri = Nothing

    Set sKategoriListesi = Nothing

    Set sSonuc = Nothing

  

End Sub