Excel'de birden çok çalışma sayfasından benzersiz değerler listesi nasıl oluşturulur?

Bir çalışma kitabındaki tüm çalışma sayfalarından benzersiz değerlerin bir listesini oluşturmanın hızlı bir yolu var mı? Örneğin, A sütununda yinelenen bazı adların listelendiği dört çalışma sayfam var ve şimdi bu sayfalardan tüm benzersiz adları yeni bir listeye çıkarmak istiyorum, bu işi Excel'de nasıl bitirebilirim?

VBA kodu ile birden çok çalışma sayfasından benzersiz değerlerin bir listesini oluşturun

---

VBA kodu ile birden çok çalışma sayfasından benzersiz değerlerin bir listesini oluşturun

Tüm çalışma sayfalarından tüm benzersiz değerleri listelemek için, aşağıdaki VBA kodu size bir iyilik yapabilir, lütfen şu şekilde yapın:

1. Basılı tutun ALT + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki makroyu modül Pencere.

VBA kodu: Birden çok çalışma sayfasından benzersiz değerlerin bir listesini oluşturun:

Sub SheelsUniqueValues()
Dim xObjNewWS As Worksheet
Dim xObjWS As Worksheet
Dim xStrAddress As String
Dim xIntRox As Long
Dim xIntN As Long
Dim xFNum As Integer
Dim xMaxC, xColumn As Integer
Dim xR As Range
xStrName = "Unique value"
Application.ScreenUpdating = False
xMaxC = 0
Application.DisplayAlerts = False
For Each xObjWS In Sheets
    If xObjWS.Name = xStrName Then
        xObjWS.Delete
        Exit For
    End If
Next
Application.DisplayAlerts = True
For xFNum = 1 To Sheets.Count
    xColumn = Sheets(xFNum).Cells.Find(What:="*", after:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    If xMaxC < xColumn Then
        xMaxC = xColumn
    End If
Next xFNum
Application.DisplayAlerts = True
Set xObjNewWS = Sheets.Add(after:=Sheets(Sheets.Count))
xObjNewWS.Name = xStrName
For xColumn = 1 To xMaxC
    xIntN = 1
    For xFNum = 1 To Sheets.Count - 1
        Set xR = Sheets(xFNum).Columns(xColumn)
        If TypeName(Sheets(xFNum).Columns(xColumn).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)) <> "Nothing" Then
            xIntRox = xR.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Sheets(xFNum).Range(Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address).Copy
            Cells(xIntN, xColumn).PasteSpecial xlValues
            xIntN = xIntRox + xIntN + 1
        End If
    Next xFNum
    If xIntRox - 1 > 0 Then
    xIntRox = xIntN - 1
    xStrAddress = Cells(1, xColumn).Address & ":" & Cells(xIntRox, xColumn).Address
    Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Range(xStrAddress).Copy
    Cells(1, xColumn + 1).PasteSpecial xlValues
    Range(xStrAddress).AdvancedFilter Action:=xlFilterInPlace, Unique:=False
    Columns(xColumn).Delete
    Range(xStrAddress).Sort key1:=Cells(1, xColumn), Header:=xlNo
    End If
Next xColumn
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

3. Yukarıdaki kodu yapıştırdıktan sonra F5 bu kodu ve adlı yeni bir çalışma sayfasını çalıştırmak için Eşsiz değer oluşturulur ve tüm sayfalardan A sütunundaki benzersiz adlar gösterilen aşağıdaki ekran görüntüsü olarak listelenir: