• DİKKAT

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

Tüm Sayfalardaki Kodları Birleştir ve Yinelenenleri Kaldır

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba Arkadaşlar,
Çok sayfalı bir dosyada, tüm sayfaların A sütununda bulunan sayıları RAPOR sayfasında toplayıp tekrar eden verileri temizleyip, küçükten büyüğe doğru sıralatmak mümkün müdür ?

Örnek dosya linki >>
 
Moderatör tarafında düzenlendi:
Merhaba,

Bu şekilde deneyin.
Kod:
Sub OzetAl()

    Dim d As Object, j As Integer, deg, i As Long

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
   
    For j = 1 To Sheets.Count
        If Sheets(j).Name <> "RAPOR" Then
            For i = 2 To Sheets(j).Cells(Rows.Count, "A").End(xlUp).Row
               deg = Sheets(j).Cells(i, "A")
               If Not d.exists(deg) Then
                   d.Add deg, Nothing
               End If
            Next i
        End If
    Next j
   
    Sheets("RAPOR").Select
    With Range("A2:A" & Rows.Count)
        .ClearContents
        Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)
        .Sort , Key1:=Range("A2"), Order1:=xlAscending
    End With

End Sub
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Bu şekilde deneyin.
Kod:
Sub OzetAl()

    Dim d As Object, j As Integer, deg, i As Long

    Set d = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False
  
    For j = 1 To Sheets.Count
        If Sheets(j).Name <> "RAPOR" Then
            For i = 2 To Sheets(j).Cells(Rows.Count, "A").End(xlUp).Row
               deg = Sheets(j).Cells(i, "A")
               If Not d.exists(deg) Then
                   d.Add deg, Nothing
               End If
            Next i
        End If
    Next j
  
    Sheets("RAPOR").Select
    With Range("A2:A" & Rows.Count)
        .ClearContents
        Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys)
        .Sort , Key1:=Range("A2"), Order1:=xlAscending
    End With

End Sub
Ömer Üstadım, yardımınız için çok çok teşekkür ederim. Harika bir kod. sağoluni varolun, sağlıcakla kalın.
 
Geri
Üst