Veri Karşılaştırma Ve Sonucu Yazma

[use2000]

Merhaba Arkadaşlar;

Ekteki excelde sayfa2 yi veritabanımız olarak kabul edelim. sayfa1 de ise aranılacak veriler bulunmakta. sayfa3 te de sonuç kısmımız bulunmakta. Yapmak istediğim sayfa1 de bulunan veriyi sayfa2 deki veri ile karşılaştırsın ve sonucu sayfa3 e yazsın. Burada önemli bir nokta var; sayfa1 de "ESER ADI" yazan hücreleri (a kolonunu) sayfa2 deki “ESER ADI” (a kolonu) ile birebir karşılaştırsın, sayfa1 deki "HAK SAHIBI" (b kolonu) ni sayfa2 deki “HAK SAHIBI” (b kolonu) ile karşılaştırsın ama hücre içerisinde sadece 1 tane ismi bile tuttursa sayfa2 deki “YANINA YAZ” (c kolonu) da yazan içeriği sayfa3 te “SONUC” kısmına yazsın. Ekteki dosyayı incelediğinizde daha net anlaşılacağımı düşünüyorum.
Teşekkürler;

 

[use2000]

arkadaşlar konu çok önemli..

 

[Ömer]

Merhaba,

Soru net değil. Sayfa3 deki tüm sütunlar makro çalışınca mı oluşacak ? Sayfa2 deki C sütunundaki veriler yazılı mı?

İstenen sadece Sayfa3 ü ölçütlere göre doldurmak mı?

 

[use2000]

Öncelikle ilginiz için çok teşekkür ederim.
Sayfa3 teki tüm veriler makro çalışınca oluşacak. Sayfa2 deki C sütünundaki veriler yazılı. Sayfa3 ü oluşturmak önemli değil, sayfa1 deki verileri sayfa2 ile dediğim ölçütlerle karşılaştırıp sayfa1 in c sütünuna da yazabilir.
Teşekkürler;

 

[Ömer]

Module kopyalayıp çalıştırın.

Sub Duzenle()
 
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, c As Range, j As Integer, dizi
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    Application.ScreenUpdating = False
    On Error Resume Next
    Sheets("Sayfa3").Select: Cells.Clear
 
    S1.Range("A:B").Copy Range("A1")
    Range("B1").Copy Range("C1"): Range("C1") = "SONUC"
 
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Set c = S2.Range("A:A").Find(Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            dizi = Split(Cells(i, "B"), "\")
            For j = 0 To UBound(dizi)
                If InStr(1, S2.Cells(c.Row, "B"), Trim(dizi(j)), 1) > 0 Then
                    Cells(i, "C") = S2.Cells(c.Row, "C")
                End If
            Next j
        End If
    Next i
 
End Sub

.

 

[use2000]

çok teşekkürler Ömer Hocam ellerinize zekanıza sağlık..