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.

Computernamen auslesenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionTipp

Kategorie: System ▸ Windows

(Tipp 569) Nachricht zum Beitrag an Autor Nach oben

Wie kann man den Namen des Computers, also des Systems, auf dem die Anwendung läuft, auslesen?

Die verschiedenen Deklarationen sind wichtig, um das Funktionieren sowohl in der 64-Bit-Version des Microsoft Office (also nicht von Windows) als auch in der 32-Bit-Version zu gewährleisten.

#If VBA7 Then Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As LongPtr) As LongPtr #Else Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long #End If Sub ComputerName() Dim lngTemp As LongPtr, strPCName As String strPCName = Space(256) lngTemp = GetComputerName(strPCName, Len(strPCName)) MsgBox strPCName End Sub

Das kann man natürlich auch als UDF erstellen:

Function ComputerName1() Dim lngTemp As LongPtr, strPCName As String strPCName = Space(256) lngTemp = GetComputerName(strPCName, Len(strPCName)) ComputerName1 = strPCName End Function

In die Zelle wird einfach =computername1() eingetragen.

Erster Buchstabe in Zeichenfolge (auch mit Regex)UDF - benutzerdefinierte Funktion

Kategorie: Stringoperationen ▸ Teile

(Tipp 173) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich den ersten Buchstaben in einer Zeichenfolge auslesen lassen?

Am einfachsten geht es sicher mit einem regulären Ausdruck (Microsoft VBScript Regular Expressions-Objektbibliothek kann auch eingebunden werden statt late binding):

Function ErsterBuchstabe(strString As String) Dim Regex As Object, regMatches If Regex Is Nothing Then Set Regex = CreateObject("VBScript.RegExp") ErsterBuchstabe = "" Regex.Pattern = "^[^A-Za-zÄÖÜäöüß]*([A-Za-zÄÖÜäöüß]).*" Set regMatches = Regex.Execute(strString) If regMatches.Count > 0 Then ErsterBuchstabe = regMatches(0).SubMatches(0) Set Regex = Nothing End Function

In die Zelle: =ErsterBuchstabe(A1).

Die folgende Funktion liefert das erste nichtnumerische Zeichen:

Function ErsteNichtZahl(Zelle) Dim intI As Integer If Len(Zelle) = 0 Then ErsteNichtZahl = "" For intI = 1 To Len(Zelle) If Not IsNumeric(Mid(Zelle, intI, 1)) Then ErsteNichtZahl = Mid(Zelle, intI, 1) Exit Function End If Next End Function

In die Zelle: =ErsteNichtZahl(A1).

Die nächste Funktion liefert den ersten Buchstaben einer Zeichenfolge:

Function ErsterBuchstabe1(Zelle) Dim intI As Integer If Len(Zelle) = 0 Then ErsterBuchstabe = "" For intI = 1 To Len(Zelle) If (Asc(Mid(Zelle, intI, 1)) >= 65 And Asc(Mid(Zelle, intI, 1)) <= 90) Or _ (Asc(Mid(Zelle, intI, 1)) >= 97 And Asc(Mid(Zelle, intI, 1)) <= 122) Or _ Asc(Mid(Zelle, intI, 1)) = 196 Or _ Asc(Mid(Zelle, intI, 1)) = 196 Or _ Asc(Mid(Zelle, intI, 1)) = 214 Or _ Asc(Mid(Zelle, intI, 1)) = 220 Or _ Asc(Mid(Zelle, intI, 1)) = 228 Or _ Asc(Mid(Zelle, intI, 1)) = 246 Or _ Asc(Mid(Zelle, intI, 1)) = 252 Then ErsterBuchstabe = Mid(Zelle, intI, 1) Exit Function Else: ErsterBuchstabe = "" End If Next End Function

In die Zelle: =ErsterBuchstabe(1A1) eingegeben werden.

Tabellenblattnamen auslesen (VBA + Formel)Makro/Sub/ProzedurFormellösung

Kategorie: Tabelle ▸ Eigenschaften

(Tipp 134) Nachricht zum Beitrag an Autor Nach oben

Wie erhalte ich den Tabellenblatt-Namen?

VBA

Sub TabellenblattName() MsgBox ActiveSheet.Name End Sub


Formel

Die Funktion =ZELLE("Dateiname";A1) gibt den Pfad der Mappe bis zur Tabelle zurück. Der Dateiname steht dabei in eckigen Klammern, danach kommt der Tabellenname. Also kann der Teil von der letzten eckigen Klammer bis zum Schluss extrahiert werden:

=RECHTS(ZELLE("Dateiname");LÄNGE(ZELLE("Dateiname"))-FINDEN("]";ZELLE("Dateiname")))

Textdatei erstellen und Text wieder in Excel einlesenMakro/Sub/ProzedurUDF - benutzerdefinierte FunktionArrayfunktion/Matrixfunktion

Kategorie: Dateien und Ordner ▸ Dateioperation

(Tipp 33) Nachricht zum Beitrag an Autor Nach oben

Wie kann ich aus einem Tabellenbereich eine Textdatei erstellen und diese Textdatei wieder in Excel einlesen?

In Spalte A wird solange gesucht, bis eine leere Zelle gefunden wird. Natürlich wäre auch eine For-Schleife mit Application.Cells(Rows.Count, 1).End(xlUp).Row möglich.

Die Daten aus A, B und C werden mit einem Semikolon als Trennzeichen in eine Textdatei eingelesen.

Einlesen in eine Textdatei mit immer gleichem Pfad:

Sub AlsTextSpeichern() Dim intI As Integer, lngDNr As LongPtr lngDNr = FreeFile 'Pfad anpassen Open "C:\Eigene Dateien\aus Tabelle.txt" For Output As #lngDNr intI = 2 'erste Zeile mit Angaben Do While Cells(intI, 1).Value <> "" 'Schleife, solange die Zelle nicht leer ist 'Übernehmen der Daten in die Textdatei Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Einlesen in eine Textdatei mit wählbarem Pfad:

Sub AlsTextSpeichern1() Dim intI As Integer, lngDNr As LongPtr Dim varPfad varPfad = Application.GetSaveAsFilename(InitialFileName:="Test", fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub lngDNr = FreeFile Open varPfad For Output As #lngDNr intI = 2 Do While Cells(intI, 1).Value <> "" Print #lngDNr, Cells(intI, 1) & ";" & Cells(intI, 2) & ";" & Cells(intI, 3) intI = intI + 1 Loop Close #lngDNr End Sub

Textdatei in Exceldatei einlesen, immer gleicher Pfad:

Da das Semikolon als Trennzeichen verwendet wurde, brauchen wir die Textdatei als solche nicht aus- und in Excel einzulesen, sondern wir können die Datei direkt öffnen:

Sub AusTextAufrufen() On Error Resume Next 'falls Datei nicht existiert 'hier nur den Pfad ändern Workbooks.OpenText Filename:="C:\Eigene Dateien\aus Tabelle.txt", DataType:=xlDelimited, semicolon:=True End Sub

Textdatei in Exceldatei einlesen, wählbarer Pfad:

Sub AusTextAufrufen1() Dim varPfad varPfad = Application.GetOpenFilename(fileFilter:="Textdateien (*.txt), *.txt") If varPfad = False Then Exit Sub Workbooks.OpenText Filename:=varPfad, DataType:=xlDelimited, semicolon:=True End Sub

Gibt es andere Trennzeichen, erfolgt das Aufteilen auf die Zellen natürlich nicht unbedingt. Dann kann entweder mit Split() gearbeitet werden oder es kann mit der integrierten Methode Text in Spalten aufgeteilt werden.


Dynamische Arrayformel mit Matrixfunktion

Möglich ist natürlich auch ab Excel 365, die Textdatei mittels benutzerdefinierter Matrixfunktion auszulesen und die Ergebnisse als Array zu übergeben:

Function DateiEinlesen(strDatei, strTrenner, intSpalten) Dim intS As Integer, lngZ As LongPtr Dim lngDNr As Long, strZeile As String, arrTemp Dim arrS() lngDNr = FreeFile lngZ = 0 Open strDatei For Input As #lngDNr Do While Not EOF(lngDNr) Line Input #lngDNr, strZeile If strZeile <> "" Then arrTemp = Split(strZeile, strTrenner) lngZ = lngZ + 1 ReDim Preserve arrS(1 To intSpalten, 1 To lngZ) For intS = 1 To intSpalten If UBound(arrTemp) >= intS Then arrS(intS, lngZ) = arrTemp(intS) Else arrS(intS, lngZ) = "" End If Next End If Loop Close #lngDNr DateiEinlesen = Application.WorksheetFunction.Transpose(arrS) End Function

In die Zelle kommt dann nur noch die Formel:

=DateiEinlesen(Pfad zur Datei;Trennzeichen;Anzahl der Spalten)

=DateiEinlesen(A1;";";4)

Allerdings sollten die Dateien natürlich nicht zu groß sein, weil die Berechnung dieser Formel sonst alles verzögern würde.

Verzeichnis auslesen (Makro und Funktion)Makro/Sub/ProzedurUDF - benutzerdefinierte Funktion

Kategorien: Dateien und Ordner ▸ Ordner und Dateien und Ordner ▸ Dateien

(Tipp 32) Nachricht zum Beitrag an Autor Nach oben

Wie kann man mit VBA ein Verzeichnis mit allen darin befindlichen Dateien auslesen?

An der Stelle des Sternchens in Dir(strOrdner & "*.*") können auch bestimmte Dateiendungen eingetragen wreden, so dass nur nach Dateien eines Typs gesucht wird.

Subs

Sollen Dateien nur direkt im Ordner, nicht aber in Unterordnern, gesucht werden, reicht dieser Code:

Sub Suchen_nur_Dateien() Dim strOrdner As String, strDatei As String Dim lngZ As LongPtr strOrdner = "C:\Eigene Dateien\" lngZ = 2 Range("a1:e50000").ClearContents strDatei = Dir(strOrdner & "*.*") Do While strDatei <> "" If strDatei <> "" Then lngZ = lngZ + 1 Cells(lngZ, 1) = strOrdner & strDatei 'Pfad Cells(lngZ, 2) = FileLen(strOrdner & strDatei) 'Größe Cells(lngZ, 3) = FileDateTime(strOrdner & strDatei) 'Datum/Zeit Cells(lngZ, 4) = strDatei 'nur Dateiname End If strDatei = Dir Loop End Sub

Soll auch in Unterordnern gesucht werden, ist dies eine Möglichkeit:

Private lngZ As LongPtr Sub Suchen_mit_Unterordnern() 'Aufruf lngZ = 2 Range("a1:e50000").ClearContents Dateisuche "C:\Eigene Dateien", "*.*" End Sub Sub Dateisuche(strOrdner As String, strDateien As String) Dim strTemp As String, strWdhlg As String strOrdner = strOrdner & IIf(Right(strOrdner, 1) <> "\", "\", "") strTemp = Dir(strOrdner & strDateien) Do While Len(strTemp) Cells(lngZ, 1) = strOrdner & strTemp 'Pfad Cells(lngZ, 2) = FileLen(strOrdner & strTemp) 'Größe Cells(lngZ, 3) = FileDateTime(strOrdner & strTemp) 'Datum/Zeit Cells(lngZ, 4) = strTemp 'nur Dateiname lngZ = lngZ + 1 strTemp = Dir() Loop strTemp = Dir(strOrdner, vbDirectory) Do While Len(strTemp) If (strTemp <> ".") And (strTemp <> "..") Then If (GetAttr(strOrdner & strTemp) And vbDirectory) = vbDirectory Then Dateisuche strOrdner & strTemp, strDateien lngZ = lngZ - 1 strWdhlg = Dir(strOrdner, vbDirectory) lngZ = lngZ + 1 Do While strWdhlg <> strTemp: strWdhlg = Dir(): Loop End If End If strTemp = Dir() Loop On Error GoTo 0 End Sub


Matrixfunktion für dynamische Arrayformel

Wenn es nicht zu viele Dateien sind, können die auch mit einer Formel, die in einer Zelle steht, ausgegeben werden (ab Excel 365). Dazu dient folgende benutzerdefinierte Funktion (UDF):

Function Suchen_nur_Dateien(strOrdner) Dim strDatei As String, arrTemp() Dim lngArr As LongPtr lngArr = 0 strDatei = Dir(strOrdner & "*.*") Do While strDatei <> "" If strDatei <> "" Then lngArr = lngArr + 1 ReDim Preserve arrTemp(1 To 4, 1 To lngArr) arrTemp(1, lngArr) = strOrdner & strDatei 'Pfad arrTemp(2, lngArr) = FileLen(strOrdner & strDatei) 'Größe arrTemp(3, lngArr) = FileDateTime(strOrdner & strDatei) 'Datum/Zeit arrTemp(4, lngArr) = strDatei 'nur Dateiname End If strDatei = Dir Loop Suchen_nur_Dateien = arrTemp End Function

Wenn in A1 der Ordner (z. B. C:\Eigene Dateien\) steht, kann in eine andere Zelle folgende Formel eingetragen werden:

=MTRANS(Suchen_nur_Dateien(A1))

Damit werden die gefundenen Dateien ab der Zelle mit der Formel gefloatet eingetragen (verschüttet). Auch die Suche mit den Unterordnern lässt sich in dieser Form gestalten - aber Vorsicht, damit die Formel nicht ewig zum Berechnen braucht.