14/04/2020, 06:16
Kategori Haricindekileri Listeleme
14/04/2020, 10:51
yyhy
Sadece boş sayfa ve B2 hücresinden başlayabilir ayrıca işleme başlamadan ve bitirdikten sonra mesaj eklenirse uygun olur.
14/04/2020, 18:15
feraz
Bir deneyiniz.Sıra numarası eklettim.
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 14/04/2020, 21:56
yyhy
Nihayetinde sonuçlandırdınız. Tam da istediğim gibi oldu. Elinize sağlık. Konu çözülmüştür.
Farez bey tekrar iyi akşamlar. Şablonda 15 adet de sonuç normal ama içerisine fazla veri attığımda sonuçta 18 fark olması gerekirken 641 fark gözüküyor. Acaba Ek dosyayı tekrar bir daha inceleyebilir misiniz? Neden olabilir. Dosya da ekleyecektim ama dosya eklemeyi sayfada göremedim. link ekliyorum
Farez bey tekrar iyi akşamlar. Şablonda 15 adet de sonuç normal ama içerisine fazla veri attığımda sonuçta 18 fark olması gerekirken 641 fark gözüküyor. Acaba Ek dosyayı tekrar bir daha inceleyebilir misiniz? Neden olabilir. Dosya da ekleyecektim ama dosya eklemeyi sayfada göremedim. link ekliyorum
14/04/2020, 22:07
feraz
Rica ederim kolay gelsin.