kod eşleştir, veriyi çokla

[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.
"L" sütununda bulunan model ile kodu ile modeller sayfasındaki kod ile eşleşip model adını ürün satırddaki bilgileri çoklmasını istiyorum. uyumlu modellerde yazan kod kadar çoğalacak kod ve model adı bilgileri aynı satıra gelecek

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

 

[Muzaffer Ali]

Merhaba.

Dosyanız ekte deneyiniz.
"Veriler" sayfasındaki veriler 5. satırdan itibaren başladığı için For Bak = 5 To ...... yazdım. Eğer başlangıç satırını değiştirirseniz buradaki 5'i de değiştirin.

 

[sevensuleyman]

Merhaba.

Dosyanız ekte deneyiniz.
"Veriler" sayfasındaki veriler 5. satırdan itibaren başladığı için For Bak = 5 To ...... yazdım. Eğer başlangıç satırını değiştirirseniz buradaki 5'i de değiştirin.

hocam çok güzel çalışıyor çok teşekkür ederim . ürün çok fazla oldugunda 10.000 satır üzerinde başlattıgımda kod bir türlü sonuçlanmıyor . çok üzün sürüyor muhtelen bunu hızlandırma şansımız varmı ?

 

[sevensuleyman]

hocam çok güzel çalışıyor çok teşekkür ederim . ürün çok fazla oldugunda 10.000 satır üzerinde başlattıgımda kod bir türlü sonuçlanmıyor . çok üzün sürüyor muhtelen bunu hızlandırma şansımız varmı ?

üstadım bir çözüm bulunabilirmi acaba ?

 

[Muzaffer Ali]

Aşağıdaki kodu deneyin.
10.000 satır üzerinde denedim yaklaşık 2 dakika sürdü.

Private Sub btnAktarimiBaslat_Click()
    Dim syfSonuc As Worksheet
    Dim Bak As Long
    Dim Uyumluluk As Variant
    Dim BakUy As Integer
    Dim SiraSonuc As Long
    Dim BulModel As Range
    
    SiraSonuc = SiraSonuc + 1
    Application.ScreenUpdating = False
    For Bak = 5 To Worksheets("Veriler").Cells(Rows.Count, "A").End(xlUp).Row
        Uyumluluk = Split(Worksheets("Veriler").Cells(Bak, "L"), "|")
        For BakUy = 1 To UBound(Uyumluluk)
            Set BulModel = Worksheets("Modeller").Range("A:A").Find(what:=Uyumluluk(BakUy - 1), lookat:=xlWhole)
            With Worksheets("Sonuc Veriler")
                SiraSonuc = SiraSonuc + 1
                .Cells(SiraSonuc, "A") = Worksheets("Veriler").Range("A" & Bak)
                If BulModel Is Nothing Then
                    MsgBox "Model Kodu : " & Uyumluluk(BakUy - 1) & vbLf & "bulunamadı."
                Else
                    .Cells(SiraSonuc, "B") = Worksheets("Modeller").Cells(BulModel.Row, "B") & " " & Worksheets("Veriler").Range("B" & Bak)
                End If
                .Cells(SiraSonuc, "C") = Worksheets("Veriler").Range("C" & Bak)
                .Cells(SiraSonuc, "D") = Worksheets("Veriler").Range("D" & Bak)
                .Cells(SiraSonuc, "E") = Worksheets("Veriler").Range("E" & Bak)
                .Cells(SiraSonuc, "F") = Worksheets("Veriler").Range("F" & Bak)
                .Cells(SiraSonuc, "G") = Worksheets("Veriler").Range("G" & Bak)
                .Cells(SiraSonuc, "H") = Worksheets("Veriler").Range("H" & Bak)
                .Cells(SiraSonuc, "I") = Worksheets("Veriler").Range("I" & Bak)
                .Cells(SiraSonuc, "J") = Worksheets("Veriler").Range("J" & Bak)
                .Cells(SiraSonuc, "K") = Worksheets("Veriler").Range("K" & Bak)
                .Cells(SiraSonuc, "L") = Uyumluluk(BakUy - 1)
            End With
        Next
    Next

    Application.ScreenUpdating = True
    MsgBox "Tamamlandı", vbInformation
End Sub