Veri getirme

[f_alkan]

Ekte sorumuz mevcuttur. Ilgilenen arkadaşlara tşk ederim..

 

[Korhan Ayhan]

Merhaba,

Tutar kısmındaki verileri birleştirerek listelemek istediğiniz için formüllerle yardımcı sütunlar kullanılarak bu işlem yapılabilir.

Alternatif olarak aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim X As Integer, BUL As Range, ADRES As String
    
    Application.ScreenUpdating = False
    
    Columns("D:E").ClearContents
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("D1"), Unique:=True
    Range("B1").Copy Range("E1")
    
    For X = 2 To Cells(Rows.Count, "D").End(3).Row
        Set BUL = Range("A:A").Find(Cells(X, "D"), , , xlWhole)
        If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                If Cells(X, "E") = "" Then
                    Cells(X, "E") = BUL.Offset(0, 1)
                Else
                    Cells(X, "E") = Cells(X, "E") & "," & BUL.Offset(0, 1)
                End If
            Set BUL = Range("A:A").FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
    Next
 
    Set BUL = Nothing
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[İhsan Tank]

Ekte sorumuz mevcuttur. Ilgilenen arkadaşlara tşk ederim..

formüllerle çözüm için
eki inceleyin lütfen
kullanılan formüller dizi formülüdür. D1 hücresindeki formülü silmeyiniz.

Dizi Formülü Formül Hücreye Girildikten Sonra Enter Tuşuna Basmadan Ctrl+Shift+Enter Tuş Kombinasyonu İle Aktif Olmaktadır. Formülün Başında Ve Sonunda { } Bu İşaretler Çıkar Elle Eklediğiniz Takdirde Formül Hata Verir.

formüllerde 1000 satır baz alınmıştır

1000 satır'ı değiştirmek için ctrl+h yapın aranan değere $1000 yeni değere $10000 yazın ve tümünü değiştir deyin.
$10000 olan yeri kendinize göre ayarlayınız.