Bul ve Numara Ver

[sarman61]

Arkadaslar elimdeki excel dosyasının birinci sayfasında yazar isimleri var ve
2.sayfada bu yazarlara karsılık gelen numaralar var benim istediğim birinci sayfadaki yazar isimlerinin 2.sayfada karsısına gelen numaraları alması ancak
1.sayfada bazı sutunlarda birden fazla yazar var "," ile ayrılmıs durumdalar onların sayı degerlerininde "," le ayrılması lazım resimde anlatmak istediklerimi daha iyi anlarsınız yardımlarınız için şimdiden teşekkürler...

 

[Mahmut Kök]

Arkadaslar elimdeki excel dosyasının birinci sayfasında yazar isimleri var ve
2.sayfada bu yazarlara karsılık gelen numaralar var benim istediğim birinci sayfadaki yazar isimlerinin 2.sayfada karsısına gelen numaraları alması ancak
1.sayfada bazı sutunlarda birden fazla yazar var "," ile ayrılmıs durumdalar onların sayı degerlerininde "," le ayrılması lazım...

Aşağıdaki kodu bir modüle ekleyip deneyiniz. Sayfa3 istediğiniz şekilde olacak. Veriniz fazla olduğundan işlemin tamamlanması vakit alacaktır. İyi çalışmalar.

Sub dizin()
Set S1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sayfa3")
s3.Cells.NumberFormat = "@"
For A = 1 To S1.[I65536].End(3).Row
    For B = 1 To 9
    If S1.Cells(A, B) = Empty Then GoTo ATLA
v = InStr(1, S1.Cells(A, B), ",")
        
        ilk = 0
        If v > 0 Then
        For C = 1 To Len(S1.Cells(A, B))
        k = Mid(S1.Cells(A, B), C, 1)
            If k = "," Then
            isim = Mid(S1.Cells(A, B), ilk + 1, C - (ilk + 1))
            Set bak = s2.Range("a1:a65536").Find(isim, lookat:=xlPart)
            If bak Is Nothing Then
            kod = "YOK"
            Else
            kod = s2.Cells(s2.Range("a1:a65536").Find(isim, lookat:=xlPart).Row, "b").Text
            End If 'BAK
            
            If ilk = 0 Then
            s3.Cells(A, B) = kod
            Else
            s3.Cells(A, B) = s3.Cells(A, B) & "," & kod
            End If 'ilk
            
            ilk = C
            End If 'k
        
        Next C
        
            isim = Mid(S1.Cells(A, B), ilk + 1, Len(S1.Cells(A, B)))
            Set bak = s2.Range("a1:a65536").Find(isim, lookat:=xlPart)
            If bak Is Nothing Then
            kod = "YOK"
            Else
            kod = s2.Cells(s2.Range("a1:a65536").Find(isim, lookat:=xlPart).Row, "b").Text
            End If 'BAK
            s3.Cells(A, B) = s3.Cells(A, B) & "," & kod
            
        Else
        isim = S1.Cells(A, B)
            Set bak = s2.Range("a1:a65536").Find(isim, lookat:=xlPart)
            If bak Is Nothing Then
            kod = "YOK"
            Else
            kod = s2.Cells(s2.Range("a1:a65536").Find(isim, lookat:=xlPart).Row, "b").Text
            End If 'BAK
        s3.Cells(A, B) = kod
        End If 'v
ATLA:
    Next B
Next
End Sub

 

[sarman61]

İşe Yaradı çok teşekkürler...

 

[sarman61]

Hocam bu kod ile başka bir işlem yapmaya çalıştım ama bir türlü çözemedim bir sorun çıkıyor.

Mesela sayfa-1 de genel yazan yere sayfa-2 deki genel in karşılığına gelen 156 numarasını vermesi gerekirken sayfa-2 deki 22 numarasına karşılık gelen sözlükler-genel in numarasını vermiş. Yaptığım bir yanlışlık mı var merak ettim. Şimdiden teşekkür ederim.

Örneği ekliyorum.

 

[Mahmut Kök]

Hocam bu kod ile başka bir işlem yapmaya çalıştım ama bir türlü çözemedim bir sorun çıkıyor.

Mesela sayfa-1 de genel yazan yere sayfa-2 deki genel in karşılığına gelen 156 numarasını vermesi gerekirken sayfa-2 deki 22 numarasına karşılık gelen sözlükler-genel in numarasını vermiş. Yaptığım bir yanlışlık mı var merak ettim. Şimdiden teşekkür ederim.

Örneği ekliyorum.

Aşağıdaki satır, kodlar içinde birkaç kez tekrar ediyor. Bu satırların hepsinde, sonda bulunan xlpart kısımlarını xlwhole olarak değiştiriniz. Kodlardaki bütün xlpart kısımları xlwhole olacak. İyi çalışmalar.

Set bak = s2.Range("a1:a65536").Find(isim, lookat:=xlpart)

 

[sarman61]

Hocam teşekkür ederim. Allah razı olsun senden.