excelde belli bir sütun içinde, diğer sütundakileri stringleri aratma

[ayb3rk]

Merhabalar,

İlk mesajım, öncelikle web sitesini çok beğendim. Çalışanlar için büyük bir kolaylık ve harika bir kütüphane olmuş.

Benim sorum şu olacak, forumda arama yaptım fakat bulamadım.

Excelde,

K2:335 sütünları arasındaki stringleri, RCN1,RCN2,RCN3,RCN4 sheetlerinin B sütünunda aratıp; bulunanları L sütununa, bulunamayanları ise M sütununa yazmak istiyorum.

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Forumumuza hoşgeldiniz.

Aşağıdaki kodu denermisiniz. Kırmızı bölüme "K2:K335" ile belirttiğiniz verilerinizin bulunduğu sayfa adını yazınız.

Option Explicit
 
Sub BUL_LİSTELE()
    Dim S1 As Worksheet, Sayfa() As Variant, Kontrol As Boolean
    Dim X As Integer, Y As Byte, SatırL As Integer, SatırM As Integer, BUL As Range
 
    Set S1 = Sheets("[COLOR=red]Sayfa1[/COLOR]")
    S1.Range("L2:M" & Rows.Count).ClearContents
 
    Sayfa = Array("RCN1", "RCN2", "RCN3", "RCN4")
    SatırL = 2
    SatırM = 2
 
    For X = 2 To S1.Cells(Rows.Count, "K").End(3).Row
        For Y = 0 To UBound(Sayfa)
            Set BUL = Sheets(Sayfa(Y)).Range("B:B").Find(S1.Cells(X, "K"), , , xlWhole)
            If Not BUL Is Nothing Then
                Kontrol = True
                GoTo Devam
            End If
        Next
Devam:
        If Kontrol = True Then
            S1.Cells(SatırL, "L") = S1.Cells(X, "K")
            SatırL = SatırL + 1
        Else
            S1.Cells(SatırM, "M") = S1.Cells(X, "K")
            SatırM = SatırM + 1
        End If
        Kontrol = False
    Next
    Set BUL = Nothing
    Set S1 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub