2 tablodan aynı alanları eşleştirip karşılığını yazma

[cns1907]

Merhabalar,

sayfa1 'deki açıklamaların koda dönüştürülmüş şeklini sayfa 2'deki kodlar ve açıklamalardan almaya çalışıyorum.
Bunun için sayfa 1 ve sayfa 2'deki sütunların hepsiyle eşleşenlerin sayfa 2'den gelen kodlarını bu sayfaya yazmaya çalıştım.
Fakat hata verdi. Nasıl yapabilirim?

Ben sadece nerede hata yaptığımı bulmak istiyorum ve yarına yetiştirmem gerekiyor.

Yardımcı olabilir misiniz?
Teşekkürler.

 

[Ömer]

Merhaba,

Sorunuz net değil. Sarı işaretli bölüme, tabloya göre ne olması gerektiğini manuel yazıp açıklama ekleyerek dosyayı tekrar eklermisiniz.

 

[cns1907]

cevabınız için teşekkürler. O satırın kod karşılığını bulmak istiyorum.

 

[snx111]

sayfa1 de yer açıp kategorilerinide benzer şekilde sıralarsanız hızlı çözüm bulunur bulmacaya benzemiş

 

[Ömer]

cevabınız için teşekkürler. O satırın kod karşılığını bulmak istiyorum.

Bu şekilde deneyin.

Private Sub CommandButton1_Click()
 
    Dim S2 As Worksheet, sat As Long, i As Long, c As Range
    Dim Adr As Variant, deg1 As String, deg2 As String
 
    Set S2 = Sheets("Sayfa2")
    Range("G2:M" & Rows.Count).ClearContents
 
    sat = 2
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
        With S2.Range("A:A")
            Set c = .Find(Cells(i, "A"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    deg1 = Cells(i, "B") & "|" & Cells(i, "C") & "|" & Cells(i, "D") _
                            & "|" & Cells(i, "E") & "|" & Cells(i, "F")
                    deg2 = S2.Cells(c.Row, "B") & "|" & S2.Cells(c.Row, "D") & "|" & _
                            S2.Cells(c.Row, "F") & "|" & S2.Cells(c.Row, "H") & "|" & S2.Cells(c.Row, "J")
    
                    If deg1 = deg2 Then
                        S2.Range("A" & c.Row & ":C" & c.Row).Copy Cells(sat, "H")
                        Cells(sat, "K") = S2.Cells(c.Row, "E")
                        Cells(sat, "L") = S2.Cells(c.Row, "G")
                        Cells(sat, "M") = S2.Cells(c.Row, "I")
                        sat = sat + 1
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next i
     
End Sub

.

 

[cns1907]

çok teşekkür ederim hocam

 

[snx111]

Güzel bir döngü benimde ilerde işime yarayacak kodlar var..