Çokludüşeyara yardım

[ugurcadir]

A STUNU B STUNU
CR00001 MP*
CR00001 TUNCAY*1
CR00001 TUNCAY 2
CR00001 VIP*İPT
CR_G_00359 ÇİMEN*1
CR_G_00359 ÇİMEN*2


Sonuç
c stunu d stunu
CR00001 MP,TUNCAY*1,TUNCAY 2, VIP*İPT
CR_G_00359 ÇİMEN*1,ÇİMEN*2

arkadaşlar yukardaki örnek için yardım gerekli. Yapmak istediğim a stunundaki listede 3 tekrar eden var bunların karşısında b stunundaki değerler gelsin aynı hücreye yanında , konularak

 

[lider22]

Makro yazsak olur mu?

 

[ugurcadir]

formülle çok denedim olmadı olur neden olmasın kardeşim

 

[lider22]

Baya uğraştırdı.
Daha önce denemediğim birşeydi, sayenizde dizi'nin dibine kadar indim.
Aşağıdaki kodu bir modül içine yerleştirin.

Function kompleara(ByVal aranan As String, _
                    ByVal dizi As Range, _
                    ByVal dizisutunu As Long, _
                    Optional ayrac As String = ", ") As String

Dim i As Long
Dim sonuc As String

For i = 1 To dizi.Rows.Count
    If Len(dizi(i, 1).Text) <> 0 Then
        If dizi(i, 1).Text = aranan Then
            sonuc = sonuc & (dizi(i).Offset(0, dizisutunu).Text & ayrac)
        End If
    End If
Next

If Len(sonuc) <> 0 Then
    sonuc = Left(sonuc, Len(sonuc) - Len(ayrac))
End If

kompleara = sonuc

End Function

Sonra aynen düşeyara yapar gibi formülü yazın. Ancak biraz değişik tabiki.
Varsayım şöyle;
A sütununda veriler ve B sütununda değerler var. Buna göre ben D2 hücresine girdiğim değeri arattım ve D3 hücresine şu formülü girdim;

=kompleara(D2;A:A;1;",")

Kod dizi olduğundan biraz yavaş sonuç vermektedir.
Faydalı olması dileğiyle...

 

[ugurcadir]

hemen bakıyorum kardeşim ellerine sağlık

 

[ugurcadir]

Dosya inanılmaz ağır ben 15 bin satır için uygulamak istiyorum sonuç bile alamadım diyebilirim.

 

[lider22]

15.000 satır mı? Yarın öğlene doğru ancak biter o
Malesef kod, dizi mantığıyla çalıştığı için bu kadar ağır çalışıyor. Her bir veri için tüm satırlara bakıp, ona göre döndürüyor. İlk değeri aklında tutuyor, sonrakileri de onunla birleştiriyor.
Mesela markete giderken yol boyunca ne alacağınızı tekrarlamak gibi düşünün
Aklınız orda olduğundan, yola konsantre olamaz düzgün yürüyemezsiniz
Başka bir çözüm bulursam, iletirim.

 

[ugurcadir]

aynen şimdilik 15.000 satır ben im tablolarım 50bin satırdan aşağıya düşmüyor formülle yaptım en fazla 3 dizin oldu aslında Levent Menteşoğlu var forum admini son çare onu arayacam

 

[burcin_end_muh]

a sutununda en fazla kac kere tekrar edıyor bır kalem?

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub ÖZET_RAPOR()
    Dim X As Long, Satir As Long
    Dim Bul As Range, Adres As String
    
    Application.ScreenUpdating = False
    
    Range("C:D").ClearContents
    Satir = 1
    Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountIf(Range("C:C"), Cells(X, 1)) = 0 Then
        Cells(Satir, 3) = Cells(X, 1)
        Set Bul = Range("A:A").Find(Cells(X, 1), Cells(Son, 1), , xlWhole, xlNext)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                Cells(Satir, 4) = Cells(Satir, 4) & "," & Bul.Offset(0, 1)
                Set Bul = Range("A:A").FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        End If
        End If
        Satir = Satir + 1
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub