Wie erstelle ich eine Liste eindeutiger Werte aus mehreren Arbeitsblättern in Excel?
Gibt es eine schnelle Möglichkeit für uns, eine Liste eindeutiger Werte aus allen Arbeitsblättern in einer Arbeitsmappe zu erstellen? Ich habe beispielsweise vier Arbeitsblätter, in denen einige Namen Duplikate in Spalte A enthalten, und jetzt möchte ich alle eindeutigen Namen aus diesen Blättern in eine neue Liste extrahieren. Wie kann ich diesen Job in Excel beenden?
Erstellen Sie eine Liste eindeutiger Werte aus mehreren Arbeitsblättern mit VBA-Code
Erstellen Sie eine Liste eindeutiger Werte aus mehreren Arbeitsblättern mit VBA-Code
Um alle eindeutigen Werte aus allen Arbeitsblättern aufzulisten, kann der folgende VBA-Code Ihnen einen Gefallen tun. Gehen Sie wie folgt vor:
1. Halten Sie die Taste gedrückt ALT + F11 Schlüssel zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.
2. Klicken Sie Insert > Modulund fügen Sie das folgende Makro in das Feld ein Modul Fenster.
VBA-Code: Erstellen Sie eine Liste eindeutiger Werte aus mehreren Arbeitsblättern:
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. Nachdem Sie den obigen Code eingefügt haben, drücken Sie F5 um diesen Code auszuführen, und ein neues Arbeitsblatt mit dem Namen Einzigartiger Wert wird erstellt und eindeutige Namen in Spalte A aus allen Blättern werden wie folgt aufgelistet:
Beste Office-Produktivitätstools
Verbessern Sie Ihre Excel-Kenntnisse mit Kutools für Excel und erleben Sie Effizienz wie nie zuvor. Kutools für Excel bietet über 300 erweiterte Funktionen, um die Produktivität zu steigern und Zeit zu sparen. Klicken Sie hier, um die Funktion zu erhalten, die Sie am meisten benötigen ...
Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich
- Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
- Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
- Steigert Ihre Produktivität um 50 % und reduziert jeden Tag Hunderte von Mausklicks für Sie!
