karışık listenin bir araya listelenmesi?

[udentr2002]

Merhaba arkadaşlar ekli dosyada yapmak istediğimi bir örnekle açıklamaya çalıştım.

Giriş sayfasında firmalar karışık halde bulunuyor. Bir buton aracılığı ile bu karışık halde (mükerrer) bulunan firmaları süzüp ayıklayarak Genel sayfasında yazdırabilrmiyiz?

Giriş sayfasındaki verilerin nasıl olması gerektiğini örnek ile Genel sayfasına gösterdim.

İlgilenen ve emeği geçen tüm arkadaşlarıma teşekkür ederim.

 

[Necdet]

Merhaba,

Biraz aceleye geldi ama idare edin, bakalım olmuş mu?

 

[isakarakus]

Merhaba,

Makronun haricinde bir yol önermek istiyorum,
bence daha sağlıklı, hızlı ve kolay.

1- Önce tablonuzu firma adına göre sıralayın. (işinizi bittiğinde sıra numarasına göre sıralayarak eski haline getirebilirsiniz tablonuzu)

2- Data>Subtotals menüsünden Firma adını grup baz alarak alt toplam uygulayın.

Bu kadar.

Örnek dosyanız ekte.

 

[Ferhat Pazarçevirdi]

Alternatif

Option Explicit
Public Sub Genel()
Dim shGR As Worksheet
Dim shGN As Worksheet
Dim i%, j%, sonilk%, son%, sonson%
Dim dg As Variant
Dim adres As String
Dim col As New Collection
Dim bul As Range
Set shGR = Sheets("Giris")
Set shGN = Sheets("Genel")
On Error Resume Next
For i = 3 To shGR.Cells(65536, 3).End(xlUp).Row
    col.Add shGR.Cells(i, 3), shGR.Cells(i, 3)
Next
On Error GoTo 0
For i = 1 To col.Count - 1
    For j = i + 1 To col.Count
        If col.Item(i) > col.Item(j) Then
            dg = col.Item(i)
            col.Item(i) = col.Item(j)
            col.Item(j) = dg
        End If
    Next j
Next i
shGN.Cells.ClearContents
shGN.Range("A2:H2").Value = shGR.Range("A2:H2").Value
For i = 1 To col.Count
    Set bul = shGR.Columns(3).Find(col.Item(i), Lookat:=xlWhole)
    If Not bul Is Nothing Then
        adres = bul.Address
        sonilk = shGN.Cells(65536, 4).End(xlUp).Row + 1
        
        Do
            son = shGN.Cells(65536, 4).End(xlUp).Row + 1
            For j = 1 To 8
                shGN.Cells(son, j) = shGR.Cells(bul.Row, j)
            Next j
            Set bul = shGR.Columns(3).FindNext(bul)
        Loop While Not bul Is Nothing And adres <> bul.Address
        
        sonson = son
        shGN.Cells(son + 1, 4) = "TOPLAM"
        shGN.Cells(son + 1, 5).Formula = "=SUM(" & shGN.Cells(sonilk, 5).Address & ":" & shGN.Cells(sonson, 5).Address & ")"
        shGN.Cells(son + 1, 7).Formula = "=SUM(" & shGN.Cells(sonilk, 7).Address & ":" & shGN.Cells(sonson, 7).Address & ")"
        shGN.Cells(son + 1, 8).Formula = "=SUM(" & shGN.Cells(sonilk, 8).Address & ":" & shGN.Cells(sonson, 8).Address & ")"
        shGN.Cells(son + 2, 4) = " "
    End If
Next i
shGN.Select
Set shGN = Nothing
Set shGR = Nothing
End Sub

 

[udentr2002]

Necdet Hocama, isa Karakuş Hocama ve Ferhat Hocama ayrı ayrı çok teşekkür ederim hepinizin ellerine sağlık Allah razı olsun
Ben Sayın Ferhat Hocamın göndermiş olduğu kodu kullandım emeğiniz için teşekkürler