Ինչպե՞ս ստեղծել Excel- ի բազմաթիվ աշխատանքային թերթերից եզակի արժեքների ցուցակ:

Կա՞ որևէ արագ եղանակ, որպեսզի ստեղծենք եզակի արժեքների ցուցակ աշխատանքային գրքի բոլոր աշխատաթերթերից: Օրինակ, ես ունեմ չորս աշխատանքային թերթ, որոնցում նշված են որոշ անուններ, որոնք պարունակում են կրկնօրինակներ A սյունակում, և այժմ ես ուզում եմ այս թերթիկներից դուրս բերել բոլոր եզակի անունները նոր ցուցակում, ինչպե՞ս կարող եմ այս գործն ավարտել Excel- ում:

Ստեղծեք եզակի արժեքների ցուցակ VBA կոդով բազմաթիվ աշխատանքային թերթերից

---

Ստեղծեք եզակի արժեքների ցուցակ VBA կոդով բազմաթիվ աշխատանքային թերթերից

Բոլոր աշխատաթերթերից բոլոր եզակի արժեքները թվարկելու համար հետևյալ VBA կոդը կարող է ձեզ լավություն բերել, արեք հետևյալ կերպ.

1, Պահեք պահեք ALT + F11 բացել ստեղները Microsoft Visual Basic հավելվածների համար պատուհան.

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 սյունակում եզակի անունները նշված են հետևյալ նկարում.