satırda yazan model bul eşleştir ve yeni satıra yaz

[sevensuleyman]

merhaba ;
dosya ekinde paylaştıgım excell dosyam var dosyamı kısaltarak ekledim yaklaşık 40.000 satırdır. hızlı çalışması için makro kod yazılırsa daha güzel olacagı kanaatindeyim.
"L" sütununda uyumlu olan modellerin kodları mevcuttur. istediğim diğer sayfada bulunan kod ile eşleşip istediğimiz şekilde aynı satır farklı sütunda listelemektir.
yeni hücrede olmasını istediğimiz "MARKA + MODEL (diğer sayfadan eşleşerek gelmeli )+ STOK ADI şeklinde olmasını istiyoruz.
Uyumlu olan model satırı gibi aynı satırda tüm modeller "MARKA + MODEL (diğer sayfadan eşleşerek gelmeli )+ STOK ADI | "MARKA + MODEL (diğer sayfadan eşleşerek gelmeli )+ STOK ADI şeklinde devam etmesidir.

üstadlarımızdan destek bekliyorum. şimdiden teşekkürler

 

[bkk]

üstad değilim ama bende denedim bakalım inşallah isteğinizi karşılamıştır,kontrol sağlar mısınız

 

[sevensuleyman]

üstad değilim ama bende denedim bakalım inşallah isteğinizi karşılamıştır,kontrol sağlar mısınız

teşekkürler fakat satıırda "|" arasındaki kodlar hepsi ayrıı ayrı modeli göstermetedir. tüm modelleri göstermememiz gerekiyor. formül değilde makro kod yazabilirseniz çok sevinirim

 

[Muzaffer Ali]

Merhaba.
Nasıl bir sonuca varmak istediğinizi anlayamadım.
L2 de "HYN-X|HYN|" yazıyor.
1- M2 ye tam olarak ne yazmasını istiyorsunuz?
2- L2 de iki tane kod var, bunlar ayrı ayrı satırlara mı yazılacak?

 

[Muzaffer Ali]

Aşağıdaki kodu dener misiniz?
Kodları veriler sayfasına kopyalayarak çalıştırın.

Sub test()
    Dim Bak As Long
    Dim Kodlar As Variant
    Dim Kod As Integer
    Dim KodBul As Range
    Dim Sonuc As String
   
    For Bak = 2 To Cells(Rows.Count, "L").End(xlUp).Row
        Kodlar = Split(Cells(Bak, "L"), "|")
        For Kod = 0 To UBound(Kodlar) - 1
            Set KodBul = Worksheets("Modeller").Range("A:A").Find(what:=Kodlar(Kod), lookat:=xlWhole)
            If KodBul Is Nothing Then
                Cells(Bak, "M") = Kodlar(Kod) & " KOD BULUNAMADI"
            Else
                If Sonuc = "" Then
                    Sonuc = Cells(Bak, "F") & " + " & Worksheets("Modeller").Cells(KodBul.Row, "B") & " + " & Cells(Bak, "B")
                Else
                    Sonuc = Sonuc & "|" & Cells(Bak, "F") & " + " & Worksheets("Modeller").Cells(KodBul.Row, "B") & " + " & Cells(Bak, "B")
                End If
            End If
        Next
        Cells(Bak, "M") = Sonuc
        Sonuc = ""
    Next
End Sub

 

[sevensuleyman]

Aşağıdaki kodu dener misiniz?
Kodları veriler sayfasına kopyalayarak çalıştırın.

Sub test()
    Dim Bak As Long
    Dim Kodlar As Variant
    Dim Kod As Integer
    Dim KodBul As Range
    Dim Sonuc As String
  
    For Bak = 2 To Cells(Rows.Count, "L").End(xlUp).Row
        Kodlar = Split(Cells(Bak, "L"), "|")
        For Kod = 0 To UBound(Kodlar) - 1
            Set KodBul = Worksheets("Modeller").Range("A:A").Find(what:=Kodlar(Kod), lookat:=xlWhole)
            If KodBul Is Nothing Then
                Cells(Bak, "M") = Kodlar(Kod) & " KOD BULUNAMADI"
            Else
                If Sonuc = "" Then
                    Sonuc = Cells(Bak, "F") & " + " & Worksheets("Modeller").Cells(KodBul.Row, "B") & " + " & Cells(Bak, "B")
                Else
                    Sonuc = Sonuc & "|" & Cells(Bak, "F") & " + " & Worksheets("Modeller").Cells(KodBul.Row, "B") & " + " & Cells(Bak, "B")
                End If
            End If
        Next
        Cells(Bak, "M") = Sonuc
        Sonuc = ""
    Next
End Sub

Çok güzel çalışıyor . Çok teşekkürler

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.