Bir listedeki kodları başka bir listede aratıp yazdırmak

[adigeturklim]

Merhaba,

Bir konuda yardıma ihtiyacım oldu. Excel dosyasına açıklama ekledim. 401 adet kodu banka işlem açıklamalarından bulup ilgili stüna yazması gerekiyor.
Desteklerinizi rica ederim.

Sayg.

 

[Korhan Ayhan]

Ekte örnek dosyanız yok..

 

[adigeturklim]

Evet Korhan bey üyeliğim bitmiş. Yükleme yapamadım. Şimdi tekrar üyelik aldım. Aktif olduysa hemen yükleme yapacağım.

 

[adigeturklim]

Merhaba tekrar, örnek dosyayı ekledim.

 

[Korhan Ayhan]

Deneyiniz.

Ofis dilinizi profilinizde göremedim. Bu sebeple kendi kullandığım dile göre yanıt verdim.

DİZİ Formüldür.

=IFERROR(OFFSET('Mağaza Bilgileri'!$B$2;MATCH(TRUE;ISNUMBER(SEARCH(" "&'Mağaza Bilgileri'!$B$3:$B$403&" ";" "&E5&" "));0););"-")

 

[adigeturklim]

Korhan bey, teşekkür ederim. Yazdığınız formül bu işi çözdü.

 

[adigeturklim]

Merhaba Korhan bey, dünkü çözümünüzü tabloda hayat geçirdik. Bunun için tekrar sağolun. Yalnız bazı satırlarda nedense karşılık getirmiyor. Bu sefer mağaza kodunu elle yazdığımızda malesef formülün üzerine yazmak zorunda kalıyoruz. Daha önce bu konu ile ilgili bir yardım istemişim. Başka bir kullanıcı ve siz kod ile bir çözüm bulmuşsunuz. ben o kodu tekrar kullandım fakat orda da ilgili stünda cümle içinde mağaza kodu olmasına rağmen karşılıklarını bulmadan boş geçiyor. Bunun bir sebebi var mıdır? Çok zamanınızı çalmadan rica etsem bakabilme şansınız olur mu.

 

[Korhan Ayhan]

Aşağıdaki gibi olabilir..

Option Explicit

Sub Kod_Bul()
    Dim S1 As Worksheet, S2 As Worksheet, Kod As Variant, X As Long
    Dim Data As Variant, Split_Data As Variant, Y As Byte
    
    Set S1 = Sheets("Mağaza Bilgileri")
    Set S2 = Sheets("Kod Ayrıştır")
    
    S2.Range("K5:K" & S2.Rows.Count).ClearContents
    
    Kod = " " & Join(Application.Transpose(S1.Range("B3:B" & S1.Cells(S1.Rows.Count, "B").End(3).Row).Value), " ") & " "
    
    Data = S2.Range("E5:E" & S2.Cells(S2.Rows.Count, "E").End(3).Row).Value
    
    ReDim Liste(1 To UBound(Data), 1 To 1)
    
    For X = LBound(Data) To UBound(Data)
        If Data(X, 1) <> "" Then
            Split_Data = Split(Data(X, 1), " ")
            For Y = LBound(Split_Data) To UBound(Split_Data)
                If InStr(1, Kod, " " & Split_Data(Y) & " ") > 0 Then
                    Liste(X, 1) = Split_Data(Y)
                    Exit For
                End If
            Next
        End If
    Next

    S2.Range("K5").Resize(X - 1) = Liste

    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Arama tamamlanmıştır.", vbInformation
End Sub