Ինչպե՞ս ստեղծել 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 սյունակում եզակի անունները նշված են հետևյալ նկարում.
Գրասենյակի արտադրողականության լավագույն գործիքները
Լրացրեք ձեր Excel-ի հմտությունները Kutools-ի հետ Excel-ի համար և փորձեք արդյունավետությունը, ինչպես երբեք: Kutools-ը Excel-ի համար առաջարկում է ավելի քան 300 առաջադեմ առանձնահատկություններ՝ արտադրողականությունը բարձրացնելու և ժամանակ խնայելու համար: Սեղմեք այստեղ՝ Ձեզ ամենաշատ անհրաժեշտ հատկանիշը ստանալու համար...
Office Tab- ը Tabbed ինտերֆեյսը բերում է Office, և ձեր աշխատանքը շատ ավելի դյուրին դարձրեք
- Միացնել ներդիրներով խմբագրումը և ընթերցումը Word, Excel, PowerPoint- ով, Հրատարակիչ, Access, Visio և Project:
- Բացեք և ստեղծեք բազմաթիվ փաստաթղթեր նույն պատուհանի նոր ներդիրներում, այլ ոչ թե նոր պատուհաններում:
- Բարձրացնում է ձեր արտադրողականությունը 50%-ով և նվազեցնում մկնիկի հարյուրավոր սեղմումները ձեզ համար ամեն օր:
