Kako ustvariti seznam edinstvenih vrednosti iz več delovnih listov v Excelu?

Ali lahko na hiter način ustvarimo seznam edinstvenih vrednosti iz vseh delovnih listov v delovnem zvezku? Na primer, imam štiri delovne liste, v katerih so nekatera imena podvojena v stolpcu A, zdaj pa želim iz teh listov izvleči vsa edinstvena imena na nov seznam, kako lahko to opravilo opravim v Excelu?

Ustvarite seznam edinstvenih vrednosti iz več delovnih listov s kodo VBA

---

Ustvarite seznam edinstvenih vrednosti iz več delovnih listov s kodo VBA

Če želite navesti vse edinstvene vrednosti z vseh delovnih listov, vam bo morda v korist naslednja koda VBA, storite tako:

1. Držite tipko ALT + F11 tipke za odpiranje Microsoft Visual Basic za aplikacije okno.

2. Kliknite Vstavi > Moduliin v mapo prilepite naslednji makro Moduli Okno.

Koda VBA: Ustvarite seznam edinstvenih vrednosti iz več delovnih listov:

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. Ko prilepite zgornjo kodo, pritisnite F5 za zagon te kode in nov delovni list z imenom Edinstvena vrednost je ustvarjen in so v stolpcu A na vseh listih navedena enolična imena, kot je prikazano na sliki spodaj: