Datenschutzerklärung


Direktnachricht



Ihre Software
Details
Excel/VBA 🔍
Add-Ins

Suche in Beispielen und Tipps zu Excel und VBA

Suchbegriff(e) mit Leerzeichen getrennt:

Arrayformeln (04): EINDEUTIG/UNIQUE (Formel + VBA)Makro/Sub/ProzedurUDF - benutzerdefinierte FunktionFormellösungArrayfunktion/MatrixfunktionTipp

Kategorie: Arrays ▸ Arrayformeln

(Tipp 116) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich die Funktion EINDEUTIG() (in VBA) nutzen?

Ab Excel 365 gibt es neben der Möglichkeit, Duplikate zu entfernen, auch eine Funktion zum Einsatz in einer Formel: EINDEUTIG(). Die Funktion sucht in einer Tabelle nach doppelten Datensätzen und gibt in der einfachen Variante jeden nur einmal aus. Weitere Informationen zu Parametern der Formel gibt es bei Microsoft: EINDEUTIG-Funktion.

Im Beispiel ist zu sehen, dass die Monate Februar und zweimal Mai im Ergebnis nur jeweils einmal erscheinen, weil diese Monate auch jeweils die gleichen Zahlen haben. Der Juni ist jedoch zweimal im Ergebnis enthalten, weil diese Datensätze unterschiedliche Zahlen haben und somit insgesamt unterschiedlich sind.

Verwendung in VBA

Auch mit VBA kann diese Funktion doppelte Datensätze ausfiltern, indem die englische Schreibweise zum Einsatz kommt:

Application.WorksheetFunction.Unique(Array)

Im Beispiel wird die Tabelle aus der Abbildung im Bereich A2:E15 verwendet. Hier sind die Datensätze bei Frau Linz identisch und zwei Datensätze bei Frau Herzig. Aus dieser Tabelle erstellen wir den Array:

arr = Range("A2:E15")

Zum Herausfiltern der doppelten Datensätze wird die Funktion eingesetzt:

arr = Application.WorksheetFunction.Unique(arr)

Weiterverarbeitung des Ergebnisarrays

Das Ergebnis ist nun in der Variablen arr der Array mit den eindeutigen Datensätzen. Dabei gibt es jedoch zwei verschiedene mögliche Fälle:

Es können (wie im Beispiel) mehrere Zeilen sein. Dann kann der Array von 1 bis zum Ubound (der hier die Anzahl der Zeilen im Ergebnis ist) mit arr(Zeile, Spalte) durchlaufen werden:

For intI = 1 To UBound(arr) MsgBox arr(intI, 1) & " " & arr(intI, 2) & ", " & arr(intI, 3) Next

Hier würde für jede Zeile eine MsgBox mit Anrede Name, Vorname erscheinen.

Es kann aber auch der Fall eintreten, dass im Ergebnis nur eine Zeile übrig bleibt, die nun als Array vorliegt. Hier enthält der Array jedoch nicht die einzelne Zeile als Arrayelement der ersten Dimension, sondern bereits die einzelnen Elemente in der ersten Ebene. In dem Fall würde ein Zugriff mit arr(Zeile, Spalte) zu einem Fehler führen, weil das Auslesen nur mit arr(Spalte) erfolgen darf.

Wenn wir im VBA-Code also beide Fälle berücksichtigen wollen, müssen wir prüfen, ob der Array aus mehreren Zeilen zu mehreren Spalten oder nur aus mehreren Spalten ohne Zeile besteht. Dazu bietet sich an, die Anzahl aller Elemente des Arrays festzustellen:

intAnzahlEl = Application.WorksheetFunction.CountA(arr)

Wenn diese Zahl gleich dem Ubound des Arrays ist, muss es sich um einen eindimensionalen handeln, weil das dann die einzelnen Spalten sind. Wenn nicht, handelt es sich um einen mehrzeiligen Array, weil es dann immer mehr Elemente als der Ubound sind (Zeilen * Spalten = intAnzahlEl).

Und so können wir in unserem Code gut die Weiche stellen - an der Stelle der MsgBoxen müsste die eigentliche Verarbeitung der Daten rein:

Sub Eindeutig_vba() Dim arr, intI As Integer, intAnzahlEl As Integer arr = Range("A2:E15") 'Zur Ausgabe von mehreren Zeilen 'arr = Range("A2:E2") 'Zur Testausgabe einer Zeile arr = Application.WorksheetFunction.Unique(arr) 'Anzahl aller(!) Elemente im Array: intAnzahlEl = Application.WorksheetFunction.CountA(arr) MsgBox "Ubound: " & UBound(arr) & vbNewLine & "Anzahl: " & intAnzahlEl If intAnzahlEl = UBound(arr) Then ' Es gibt nur eine Zeile MsgBox arr(1) & " " & arr(2) & ", " & arr(3) Else ' Mehrere Zeilen For intI = 1 To UBound(arr) MsgBox arr(intI, 1) & " " & arr(intI, 2) & ", " & arr(intI, 3) Next End If End Sub

Tipp - Sortieren:

Wenn das Ganze sortiert werden soll, kann das auch gleich am Anfang mit der integrierten Funktion erledigt werden:

arr = Application.WorksheetFunction.Unique(arr) arr = Application.WorksheetFunction.Sort(arr, 2)

In dem Beispiel wäre der frische Array nach den Namen sortiert.

Kommagetrennte Vornamen zählen (mit Arrayfunktionen)UDF - benutzerdefinierte FunktionArrayfunktion/Matrixfunktion

Kategorien: Tabelle ▸ Zellen und Stringoperationen ▸ Teile

(Tipp 138) Nachricht zum Beitrag an Autor Nach oben

In einigen Zellen stehen mehrere Vornamen, durch ein Komma getrennt. Wie kann ich die Vornamen unter dem Datenbereich auswerten lassen? Beispiel: Tobias, Jens Ingo Frank, Tobias Ingrid, Sabine

Drei Varianten:

Namen zählen ab Excel 365: dynamische Arrayformeln

Sub Namen_Zaehlen() Dim intN As Integer Dim rngZelle As Range Dim arrTemp Dim arrSammler(), lngArrSammler As Long intN = 0 lngArrSammler = 0 For Each rngZelle In Range("A1:B4").Cells arrTemp = Split(rngZelle, ", ") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(1 To lngArrSammler) arrSammler(lngArrSammler) = Trim(arrTemp(intN)) Next End If Next MsgBox UBound(Application.WorksheetFunction.Unique(arrSammler, 1)) End Sub


Namen ausgeben ab Excel 365: dynamische Arrayformeln als Matrixfunktion

Function Einzelnamen(ByRef rngRange As Range) Dim intN As Integer Dim rngZelle As Range Dim arrTemp Dim arrSammler(), lngArrSammler As Long intN = 0 lngArrSammler = 0 For Each rngZelle In rngRange.Cells arrTemp = Split(rngZelle, ", ") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(1 To lngArrSammler) arrSammler(lngArrSammler) = Trim(arrTemp(intN)) Next End If Next Einzelnamen = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Unique(arrSammler, 1)) End Function

In die Zelle kann dann einfach die Formel:

=Einzelnamen(A1:B8)


Variante für ältere Versionen

'An den Anfang des Moduls: Dim arrSammler(), lngArrSammler As Long Sub Auswerten() Dim intN As Integer, intZ As Integer Dim rngZelle As Range Dim arrTemp intN = 0 lngArrSammler = -1 For Each rngZelle In Range("A1:B4").Cells arrTemp = Split(rngZelle, ",") If UBound(arrTemp) > -1 Then For intN = 0 To UBound(arrTemp) Sammler arrTemp(intN) Next End If Next lngArrSammler = lngArrSammler + 1 MsgBox lngArrSammler End Sub Function Sammler(ByVal strName As String) Dim lngZ As Long, strTemp As String strTemp = LCase(Trim(strName)) If lngArrSammler >= 0 Then For lngZ = 0 To lngArrSammler If LCase(arrSammler(lngZ)) = strTemp Then Exit Function Next End If lngArrSammler = lngArrSammler + 1 ReDim Preserve arrSammler(lngArrSammler) arrSammler(lngArrSammler) = Trim(strName) End Function

Die Funktion prüft nur, ob der aktuelle Name bereits im Array ist und erweitert den Array. Geschmacksache - das kann natürlich auch in die eigentliche Routine.

Tabellenblatt auf mehrere Tabellenblätter aufteilen (EINDEUTIG(), FILTER())Makro/Sub/ProzedurArrayfunktion/Matrixfunktion

Kategorien: Mappe ▸ Tabellen und Tabelle ▸ Matrix

(Tipp 551) Nachricht zum Beitrag an Autor Nach oben

Auf einem Tabellenblatt befinden sich in Spalte C die Namen der Mitarbeiter, daneben ihre Daten. Für jeden Mitarbeiter kann es mehrere Zeilen geben. Wie kann ich für jeden Mitarbeiter ein neues Blatt per VBA erstellen, auf dem seine Daten untereinander aufgelistet sind?

Einsatz dynamischer Arrayfunktionen

Ein Lösungsansatz, der allerdings erst ab Excel 365 funktioniert, ist der Einsatz dynamischer Arrayfunktionen. Dadurch können die Daten vorgefiltert werden und per Schleife müssen nur noch die jeweiligen Ergebnismengen verarbeitet werden; eine Schleife über alle Zeilen ist nicht notwendig.

Gegeben ist die Tabelle mit den Namen in Spalte C ab Zeile 2 und Daten bis zur Spalte G. Dies müsste ggf. angepasst werden. Die letzte Zeile der Tabelle wird aufgrund der Daten in C automatisch erkannt.

Zuerst kommt die Tabellenblattfunktion EINDEUTIG() (UNIQUE()) zum Zug. Sie enthält jeden Namen aus Spalte C genau einmal. Dies ist wichtig, da für jeden Mitarbeiter ja nur ein Blatt erstellt werden soll. Über das Ergebnis dieser Formel kann dann die Hauptschleife laufen: For Each varName In varNamen

In der Schleife wird dann für jeden Namen wieder eine Arrayfunktion verwendet: FILTER(). Diese liefert einen Array, der bei mehreren Zeilen zum Mitarbeiter aus diesen Zeilen mit den Zellen besteht oder bei nur einer Zeile aus den einzelnen Zellen. Damit hier kein Fehler auftritt, wird mit If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then geprüft, wie viele Elemente der Array hat. Ist die Größe des Arrays gleich der Anzahl der einzelnen Elemente, handelt es sich um eine Zeile; die Elemente sind die Zellen. Ist die Größe des Arrays kleiner als die Anzahl der einzelnen Elemente, handelt es sich um mehrere Zeilen.

Beispiel: Bei zwei Zeilen ist der Ubound = 2. Jede Zeile hat vier Zellen, also sind das 2 Zeilen * 4 Zellen = 8 Elemente. Ubound ist kleiner als die Anzahl der Elemente. Bei nur einer Zeile hat der Array vier Elemente (die Zellen eben). Da der Array hier nicht nach Zeilen untergliedert ist, sondern die Zellen in der ersten Ebene liegen, ist hier Ubound auch = 4.

Diese Arrayelemente werden dann nur noch auf das hinzugefügte Blatt eingelesen.

Der Code:

Sub Aufteilen_Filter() Dim lngZ As LongPtr, lngLZ As LongPtr, intZ As Integer Dim strAktBlatt As String, strFormel As String Dim wksNeu As Worksheet Dim varFilt, varNamen, varName strAktBlatt = "Mitarbeiter" lngLZ = Cells(Rows.Count, 3).End(xlUp).Row varNamen = Application.WorksheetFunction.Unique(Range("C2:C" & lngLZ)) If IsArray(varNamen) Then For Each varName In varNamen strFormel = "=FILTER(" & strAktBlatt & "!C2:G" & lngLZ & "," & strAktBlatt & "!C2:C" & lngLZ & "=""" & varName & """)" varFilt = Application.Evaluate(strFormel) If IsArray(varFilt) Then Set wksNeu = Worksheets.Add(after:=Sheets(Sheets.Count)) wksNeu.Name = varName Sheets(strAktBlatt).Range("C1:G1").Copy wksNeu.Range("C1") lngZ = 1 If UBound(varFilt) = Application.WorksheetFunction.CountA(varFilt) Then lngZ = lngZ + 1 For intS = 1 To UBound(varFilt) wksNeu.Cells(lngZ, intS + 2) = varFilt(intS) '+2 weil Spalte C Next Else For intZ = 1 To UBound(varFilt) lngZ = lngZ + 1 For intS = 1 To 5 wksNeu.Cells(lngZ, intS + 2) = varFilt(intZ, intS) Next Next End If End If Next End If End Sub


Schleife

Vor Excel 365 funktioniert die Variante mit den dynamischen Arrayfunktionen noch nicht. Deshalb hier noch eine ältere Möglichkeit:

Die Routine duchläuft die Spalte der Mitarbeiternamen von oben nach unten. Mit Hilfe der ZÄHLENWENN-Funktion wird geprüft, ob sich unterhalb der gerade durchlaufenen Zelle der Name des Mitarbeiters nochmals befindet. Wenn nicht, wird ein neues Blatt mit dem Namen des Mitarbeiters angelegt und es werden die Spaltenüberschriften eingefügt.

Zum Schluss werden die Daten zu den Mitarbeitern auf deren Blättern eingetragen.

Sub Aufteilen_Schleife() Dim lngZ As Long, lngLZ As Long, intAnzahl As Integer Dim lngAktZeile As Long Dim strAktBlatt As String, strName As String Dim ints, intAnzahlTB, intAnzahlSpalten As Integer Dim objNeuBlatt As Worksheet Dim lngErsteZeile As Long Dim strSpalte As String 'Hier anpassen: lngErsteZeile = 2 strSpalte = "C" strAktBlatt = ActiveSheet.Name lngLZ = Range(strSpalte & 65536).End(xlUp).Row 'Blätter mit den Spaltenüberschriften erstellen: For lngZ = lngErsteZeile To lngLZ If Sheets(strAktBlatt).Range(strSpalte & lngZ) <> "" Then intAnzahl = Application.WorksheetFunction.CountIf(Sheets(strAktBlatt).Range(strSpalte & lngZ + 1 & ":" & strSpalte & "65536"), Sheets(strAktBlatt).Range(strSpalte & lngZ)) If intAnzahl = 0 Then Set objNeuBlatt = Worksheets.Add(after:=Sheets(Sheets.Count)) objNeuBlatt.Name = Sheets(strAktBlatt).Range(strSpalte & lngZ) For ints = 1 To Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column objNeuBlatt.Cells(1, ints) = Sheets(strAktBlatt).Cells(1, ints) Next ints End If End If Next lngZ 'Übernahme der Daten auf die einzelnen Blätter: intAnzahlSpalten = Sheets(strAktBlatt).Cells(1, Columns.Count).End(xlToLeft).Column For lngZ = lngErsteZeile To lngLZ strName = Sheets(strAktBlatt).Range(strSpalte & lngZ) If strName <> "" Then lngAktZeile = Sheets(strName).Range(strSpalte & 65536).End(xlUp).Row + 1 Sheets(strName).Range(Sheets(strName).Cells(lngAktZeile, 1), Sheets(strName).Cells(lngAktZeile, intAnzahlSpalten)).Value = _ Sheets(strAktBlatt).Range(Sheets(strAktBlatt).Cells(lngZ, 1), Sheets(strAktBlatt).Cells(lngZ, intAnzahlSpalten)).Value End If Next lngZ End Sub