2 listenin karşılaştırması

kazuya55 · Perşembe saat 11:08'de

benim bir yardımınıza ihtiyacım var bilgili arkadaşlara zahmet olmazsa,
A-B-C satırlarında liste var , E-F-G satırlarında da başka bir liste var, E satırındaki veri A satırında varsa yukarıdan aşağı tarayıp bulup eşleşen verileri (A'da eşleşenin a-b-c verilerini ) K-L-M satırlarına sırayla işlemesini sağlayan kodu yazmanız mümkünmü acaba? bazen düşeyara gibi formüllerde tc sayıları referans alındığında farklı formatlar olduğundan eşleşmeyi formül tam karşılayamayabiliyor o yüzden kodla mümkünse daha pratik olucak. sağolun.

Muzaffer Ali · Perşembe saat 11:35'de

Merhaba.
Bu kodu deneyin.

Kod:

Sub Aktar()
    Dim Bak As Long
    Dim SonSatir As Long
    Dim Bul As Range

    SonSatir = 2
    For Bak = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        Set Bul = Range("A:A").Find(What:=Cells(Bak, "E").Value, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Range("K" & SonSatir & ":M" & SonSatir).Value = Bul.Resize(, 3).Value
            SonSatir = SonSatir + 1
        End If
    Next
End Sub

htsumer · Perşembe saat 14:09'de

Bunuda denersiniz

PHP:

Sub EslesenVerileriKopyala()
    Dim ws As Worksheet
    Dim sonA As Long, sonE As Long, sonK As Long
    Dim i As Long, j As Long
    Dim aranan As String
    
    Set ws = ActiveSheet
    
    ' A sütunundaki son satır
    sonA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' E sütunundaki son satır
    sonE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    ' K sütununa yazmaya başlamak için ilk satır
    sonK = 2 ' Başlık varsa 2, yoksa 1
    
    ' E sütunundaki her veri için döngü
    For i = 2 To sonE ' Başlık varsa 2, yoksa 1
        aranan = CStr(ws.Cells(i, "E").Value)
        
        ' A sütununda eşleşenleri bul
        For j = 2 To sonA
            If Trim(CStr(ws.Cells(j, "A").Value)) = Trim(aranan) Then
                ' K-L-M sütunlarına A-B-C değerlerini sırayla yaz
                ws.Cells(sonK, "K").Value = ws.Cells(j, "A").Value
                ws.Cells(sonK, "L").Value = ws.Cells(j, "B").Value
                ws.Cells(sonK, "M").Value = ws.Cells(j, "C").Value
                sonK = sonK + 1
            End If
        Next j
    Next i
    
    MsgBox "Veriler K-L-M sütunlarına kopyalandı!", vbInformation
End Sub

kazuya55 · Perşembe saat 15:13'de

Muzaffer Ali' Alıntı:

Merhaba.
Bu kodu deneyin.

Kod:

Sub Aktar()
    Dim Bak As Long
    Dim SonSatir As Long
    Dim Bul As Range

    SonSatir = 2
    For Bak = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        Set Bul = Range("A:A").Find(What:=Cells(Bak, "E").Value, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Range("K" & SonSatir & ":M" & SonSatir).Value = Bul.Resize(, 3).Value
            SonSatir = SonSatir + 1
        End If
    Next
End Sub

hocam teşekkür ederim emeğin için kodu çalıştırdım ama hiç bir tepkime vermedi, yani m satırına eşleşen verileri yada her hangi bir veri getirmedi.

htsumer · Perşembe saat 15:22'de

A-B-C sütunları → İlk liste, burada ana veriler var.
E-F-G sütunları → Karşılaştırılacak ikinci liste, E sütunu anahtar (ör. TC kimlik).
K-L-M sütunları → E sütunundaki her değer için A-B-C’den eşleşen satır verileri buraya kopyalar

Veri tipleri / boşluklar
- Senin veriler A ve E sütununda olabilir ama bazen Number Stored as Text veya başında/sonunda boşluk olabiliyor.
- Kodda Trim kullanılmış ama bazı durumlarda "55" (metin) ile 55 (sayı) eşleşmez.
Başlık satırı
- Kod 2’den başlıyor (For i = 2 To sonE) → eğer başlık yoksa ilk satırı atlar.
Boş hücreler
- Eğer E sütununda boş hücre varsa aranan = "" olur ve eşleşme sağlanmaz.
Son satır hesaplaması
- sonA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  → Eğer A sütununda boş satırlar varsa doğru olmayabilir.

C++:

Sub EslesenVerileriKopyala()
    Dim ws As Worksheet
    Dim sonA As Long, sonE As Long, sonK As Long
    Dim i As Long, j As Long
    Dim aranan As String, veriA As String
    
    Set ws = ActiveSheet
    
    ' Son satırları güvenli şekilde bul
    sonA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    sonE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    sonK = 2 ' K-L-M sütununa yazmaya başlamak için
    
    ' E sütunundaki her veri için döngü
    For i = 2 To sonE
        If ws.Cells(i, "E").Value <> "" Then
            aranan = CStr(ws.Cells(i, "E").Value)
            
            ' A sütununda eşleşenleri bul
            For j = 2 To sonA
                If ws.Cells(j, "A").Value <> "" Then
                    veriA = CStr(ws.Cells(j, "A").Value)
                    ' Trim ve LCase ile karşılaştır
                    If LCase(Trim(veriA)) = LCase(Trim(aranan)) Then
                        ' K-L-M sütunlarına kopyala
                        ws.Cells(sonK, "K").Value = ws.Cells(j, "A").Value
                        ws.Cells(sonK, "L").Value = ws.Cells(j, "B").Value
                        ws.Cells(sonK, "M").Value = ws.Cells(j, "C").Value
                        sonK = sonK + 1
                    End If
                End If
            Next j
        End If
    Next i
    
    MsgBox "Veriler K-L-M sütunlarına kopyalandı!", vbInformation
End Sub

kazuya55 · Perşembe saat 15:26'de

teşekkürler oldu, her ikinizin de eline sağlık

htsumer · Perşembe saat 15:38'de

Son kod çalıştı ise;
Bu versiyon özellikle büyük veri setlerinde çok hızlı çalışır çünkü her E sütunu için A sütununu baştan taramak yerine, A sütunundaki verileri bir sözlüğe atıyoruz ve doğrudan eşleşmeyi alıyoruz.

C++:

Sub EslesenVerileriKopyala_Hizli()
    Dim ws As Worksheet
    Dim sonA As Long, sonE As Long, sonK As Long
    Dim i As Long
    Dim dict As Object
    Dim key As String
    
    Set ws = ActiveSheet
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Son satırları bul
    sonA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    sonE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    sonK = 2 ' K-L-M sütununa yazmaya başlamak için
    
    ' 1️⃣ A sütunundaki değerleri sözlüğe ekle
    ' Key = A değeri + "|" + Dizi index (B-C sütunlarını alabilmek için)
    For i = 2 To sonA
        If ws.Cells(i, "A").Value <> "" Then
            key = LCase(Trim(ws.Cells(i, "A").Value)) & "|" & ws.Cells(i, "D").Value
            ' Eğer key yoksa, değer olarak B ve C sütunlarını dizi halinde ekle
            If Not dict.Exists(key) Then
                dict.Add key, Array(ws.Cells(i, "B").Value, ws.Cells(i, "C").Value)
            End If
        End If
    Next i
    
    ' 2️⃣ E ve F sütunlarını kullanarak eşleşenleri K-L-M sütunlarına yaz
    For i = 2 To sonE
        If ws.Cells(i, "E").Value <> "" Then
            key = LCase(Trim(ws.Cells(i, "E").Value)) & "|" & ws.Cells(i, "F").Value
            If dict.Exists(key) Then
                ws.Cells(sonK, "K").Value = ws.Cells(i, "E").Value ' A değeri
                ws.Cells(sonK, "L").Value = dict(key)(0)          ' B değeri
                ws.Cells(sonK, "M").Value = dict(key)(1)          ' C değeri
                sonK = sonK + 1
            End If
        End If
    Next i
    
    MsgBox "Veriler K-L-M sütunlarına hızlı şekilde kopyalandı!", vbInformation
End Sub

kazuya55 · Perşembe saat 16:32'de

htsumer' Alıntı:

Son kod çalıştı ise;
Bu versiyon özellikle büyük veri setlerinde çok hızlı çalışır çünkü her E sütunu için A sütununu baştan taramak yerine, A sütunundaki verileri bir sözlüğe atıyoruz ve doğrudan eşleşmeyi alıyoruz.

C++:

Sub EslesenVerileriKopyala_Hizli()
    Dim ws As Worksheet
    Dim sonA As Long, sonE As Long, sonK As Long
    Dim i As Long
    Dim dict As Object
    Dim key As String
  
    Set ws = ActiveSheet
    Set dict = CreateObject("Scripting.Dictionary")
  
    ' Son satırları bul
    sonA = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    sonE = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    sonK = 2 ' K-L-M sütununa yazmaya başlamak için
  
    ' 1️⃣ A sütunundaki değerleri sözlüğe ekle
    ' Key = A değeri + "|" + Dizi index (B-C sütunlarını alabilmek için)
    For i = 2 To sonA
        If ws.Cells(i, "A").Value <> "" Then
            key = LCase(Trim(ws.Cells(i, "A").Value)) & "|" & ws.Cells(i, "D").Value
            ' Eğer key yoksa, değer olarak B ve C sütunlarını dizi halinde ekle
            If Not dict.Exists(key) Then
                dict.Add key, Array(ws.Cells(i, "B").Value, ws.Cells(i, "C").Value)
            End If
        End If
    Next i
  
    ' 2️⃣ E ve F sütunlarını kullanarak eşleşenleri K-L-M sütunlarına yaz
    For i = 2 To sonE
        If ws.Cells(i, "E").Value <> "" Then
            key = LCase(Trim(ws.Cells(i, "E").Value)) & "|" & ws.Cells(i, "F").Value
            If dict.Exists(key) Then
                ws.Cells(sonK, "K").Value = ws.Cells(i, "E").Value ' A değeri
                ws.Cells(sonK, "L").Value = dict(key)(0)          ' B değeri
                ws.Cells(sonK, "M").Value = dict(key)(1)          ' C değeri
                sonK = sonK + 1
            End If
        End If
    Next i
  
    MsgBox "Veriler K-L-M sütunlarına hızlı şekilde kopyalandı!", vbInformation
End Sub

halloldu benden kaynaklanmış sağolun tekrardan

Muzaffer Ali · Perşembe saat 16:39'de

kazuya55' Alıntı:
hocam teşekkür ederim emeğin için kodu çalıştırdım ama hiç bir tepkime vermedi, yani m satırına eşleşen verileri yada her hangi bir veri getirmedi.

Yazdığım kod A sütunun ile E sütunun karşılaştırır aynı olanları M sütununa aktarır.
Kodu deneyerek gönderdim çlışması lazım.
Dosyanızı paylaşırsanız kontrol edelim.

2 listenin karşılaştırması

kazuya55

Muzaffer Ali

Destek Ekibi

htsumer

Altın Üye

kazuya55

htsumer

Altın Üye

kazuya55

htsumer

Altın Üye

kazuya55

Muzaffer Ali

Destek Ekibi