如何在Excel中的多個工作表中創建唯一值列表？

有什麼快速的方法可以讓我們從工作簿中的所有工作表中創建唯一值列表？ 例如，我有四個工作表，其中一些名稱包含A列中的重複名稱，現在，我想將這些表中的所有唯一名稱提取到一個新列表中，如何在Excel中完成此工作？

使用VBA代碼從多個工作表中創建唯一值列表

---

使用VBA代碼從多個工作表中創建唯一值列表

要列出所有工作表中的所有唯一值，請按照以下VBA代碼進行操作：

1。 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊，然後將以下宏粘貼到 模塊 窗口。

VBA代碼：從多個工作表中創建唯一值的列表：

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。 粘貼上面的代碼後，然後按 F5 運行此代碼，以及名為 獨特價值 創建並在所有工作表的A列中列出唯一名稱，如下所示：