• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

verileri arası eşleştirme

Katılım
3 Ocak 2014
Mesajlar
50
Excel Vers. ve Dili
2010 türkçe
merhabalar arkadaslar su komutu nasıl verebilirim b sutunu içerisindeki isimleri g ve h içerisinde arasın ve bulduktan sonra ve aynı satıra aynı isimleri eslestirsin tabiki c,d ve ı,j sutunlarıda bunlarla birlikte aynı satıra gecerken isimlerle birlikte değişsin çünkü tek tek ctrl+f yapıp arayıp bulmaktan ve zaman kaybetmekten bıkıyorum
 

Ekli dosyalar

Merhaba şu şekilde bir kod yazdım ama bu sadece bire bir eşleşme olduğu zaman işlem yapıyor.
Kod:
Sub KOD()
For a = 1 To Range("B65500").End(3).Row
    t = Split(Cells(a, "B"), " - ")
    For b = 1 To Range("G65500").End(3).Row
        If Cells(b, "G") = t(0) And Cells(b, "H") = t(1) Then
            Cells(a, "L") = Cells(b, "G")
            Cells(a, "M") = Cells(b, "H")
            Cells(a, "N") = Cells(b, "I")
            Cells(a, "O") = Cells(b, "J")
        End If
    Next
Next
End Sub
Mesela; B sütünunda Bayer Leverkusen yazarken diğer sütunda B.Leverkusen yazdığı için eşleşme bulamıyor.
Kelime araması yaptırdığımız zaman da aynı kelime ile başlayan veya biten birden fazla takım olduğu için hatalar olacaktır. İsterseniz kullanıcı denetimli birşeyler yapmaya çalışabilirim. Yani eşleşme bulduğunda size sorar onay aldıktan sonra yazar.
 
Aşağıdaki linkteki resimli anlatımı takip edin.
en son açılan beyaz sayfaya bu kodu yapıştırabilirsiniz. Daha sonra Alt+F8 ile kodu çalıştırabilirsiniz.
http://www.excel.web.tr/f157/modul-ekleme-resimli-anlatym-t73353.html

Bir de bu kod var kelime araması yapıp eşleştirme bulduğunda size uyarı veriyor. Daha güvenilir sonuçlar alabilirsiniz.
İyi çalışmalar...

Kod:
Sub KOD2()
On Error Resume Next
Range("L:O").ClearContents
For a = 1 To Range("B65500").End(3).Row
    t = Split(Cells(a, "B"), " - ")
    t1 = Split(t(0), " ")
    For i = LBound(t1) To UBound(t1)
        If Len(t1(i)) < 3 Then GoTo 9
        
        Set c = Range("G:G").Find(t1(i))
        adr = c.Address
        
        If c Is Nothing Then GoTo 9
        Do
            msj = MsgBox("Esleşme bulundu. Kayıt yapılsın mı?" & Chr(10) & Chr(10) & _
                            Cells(a, "B") & Chr(10) & c.Text & " - " & c.Offset(0, 1).Text, vbYesNoCancel)
            If msj = vbYes Then
                Cells(a, "L") = c
                Cells(a, "M") = c.Offset(0, 1)
                Cells(a, "N") = c.Offset(0, 2)
                Cells(a, "O") = c.Offset(0, 3)
                GoTo 10
            ElseIf msj = vbNo Then
                Set c = Range("G:G").FindNext(c)
            Else
                Exit Sub
            End If
        Loop Until c Is Nothing Or c.Address = adr
9
    Next
10
Next
End Sub
 

Ekli dosyalar

Son düzenleme:
hocam dediklerinizi yaptım excelde sayfa adı değişşti makro oldu şimdi ne yapmam gerekiyor
 
hocam eline saglık ancak tam istedigim değil yarın tam bakarız olurmu iyi geceler
 
hocam son olarak sizden şunu talep edeceğim eklemiş oldugunuz dosyada kod 1 olarak su komutu verelim b sutunundaki satırları g ve h içerisinde arasın aynı kelimeleri buldugunda bana degerleri c ve ı olarak versin kod 2 olarakta su komutu verelim b sutunundaki satırları g ve h de arasın aynı kelimeleri buldugunda bana degerleri d ve j olarak satır satır versin tekrardan dosyayı düzenleyip ek olarak yayınlarsanız cok mutlu olurum şimdiden teşekkür ederim
 
Merhaba,
Ekteki dosyayı inceleyiniz.
L:O arasına c ve ı sütunlarını
Q:T arasına d ve j sütunlarını yazar.
 

Ekli dosyalar

Son düzenleme:
ustad bir hata var 2. komut verirken d ve j yi bulmuyor d ve ı yı buluyor sizden ricam tekrar düzenlemeniz teşekkür ederim
 
14. mesajdaki dosya güncellendi...
 
Geri
Üst