• DİKKAT

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

Farklı bir filtreleme ve birleştirme

  • Konbuyu başlatan Konbuyu başlatan kaant
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Katılım
17 Aralık 2007
Mesajlar
28
Excel Vers. ve Dili
2002 (10.4302.4219) SP-2
Merhaba,

Ekteki dosyadan da göreceğiniz üzere, verileri filtrelemek ve birleştirmek istiyorum. Diğer taraftan, bu iş için -mümkünse- makro kullanmamak istiyorum.

Dataset olarak belirttiğim liste, aslında binlerce satırdan oluşan bir dosya. Özet olarak almak istediğim ikinci tabloyu ayrı bir sayfaya listelemem gerekmekte.

Görüş ve önerileriniz için şimdiden teşekkürler.
 

Ekli dosyalar

Son düzenleme:
.
Merhaba,

Alternatif olsun..

Kod:
Option Explicit
Sub Filtre_Birleştir()
Dim i As Long, son As Long, c As Range, ilkadres As Variant
Application.ScreenUpdating = False
 
Columns("I:K").ClearContents: [C1].Copy [K1]
Columns("A:C").AdvancedFilter xlFilterCopy, CopyToRange:=[L1], Unique:=True
Columns("A:B").AdvancedFilter xlFilterCopy, CopyToRange:=[I1], Unique:=True
 
son = Cells(Rows.Count, "L").End(xlUp).Row
For i = 2 To Cells(Rows.Count, "I").End(xlUp).Row
    Set c = Range("L2:L" & son).Find(Cells(i, "I"), LookIn:=xlValues)
    If Not c Is Nothing Then
        ilkadres = c.Address
        Do
 
            If Cells(i, "J") = Cells(c.Row, "M") Then
                Cells(i, "K") = Cells(i, "K") & "-" & Cells(c.Row, "N")
            End If
 
            Set c = Range("L2:L" & son).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
Cells(i, "K") = WorksheetFunction.Substitute(Cells(i, "K"), "-", "", 1)
Next i
 
Columns("L:N").Clear
Application.ScreenUpdating = True
 
End Sub
.
 
Merhaba;
Alternatif olsun. Eki inceleyin.
İyi çalışmalar.
 

Ekli dosyalar

Çok teşekkür ederim; çok faydası oldu.


İyi günler, iyi çalışmalar.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst