VBA ist extrem flexibel. Das hat Vor- und Nachteile:
+ Der Code kann sich an jede Konstellation anpassen - kleine Änderungen der Daten können Laufzeitfehler verursachen
Ein Beispiel: Wenn der Code einen String in einer Zelle erwarten (Kerber), ist dies völlig anderst als wenn in der Zelle steht: "Kerber" & chr(10) & "Mustermann".
Im zweiten Fall muss die Zelle in die beiden Namen gesplittet, also ein Array erzeugt werden. Der Programmcode muss unterscheiden zwischen einem String und einem Array. Falls das schiefgeht, bricht VBA ab und der Debugger öffnet sich.
19.10.2018, 14:04 (Dieser Beitrag wurde zuletzt bearbeitet: 19.10.2018, 14:04 von schauan.)
Hallöchen,
wenn man generell mit Array's arbeitet, stört ein einfacher Namenseintrag nicht. Man muss lediglich unter Umständen beachten, dass das Minimum dann bei 1 liegt ..
Code:
Option Explicit Sub test() Dim a, b, c, d a = "Kerber" 'erzeugt ein Array mit einem Element b = Split(a, Chr(10)) c = "Kerber" & Chr(10) & "Mustermann" 'erzeugt ein Array mit zwei Elementen d = Split(c, Chr(10)) End Sub
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
mit seinem Beitrag gewinnt Schaun den Titel "Array-Held des Tages". Mit diesem Ansatz reduziert sich der Code zu
Code:
Sub V4() Dim NN For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row NN = Split(Cells(i, 3), Chr(10)) VN = Split(Cells(i, 4), Chr(10)) Gb = Split(Cells(i, 5), Chr(10))
If UBound(NN) < UBound(VN) Then ReDim Preserve NN(UBound(VN)) End If For d = 1 To UBound(NN) If NN(d) = "" Then NN(d) = NN(d - 1) Debug.Print "----->", NN(d) Next d Debug.Print , Join(NN, " | ")
For d = 0 To UBound(VN) VN(d) = NN(d) & " " & VN(d) & " " & CDate(Gb(d)) Next d Debug.Print Join(VN, ", ") Next i End Sub
Für den Titel "Hacker des Tages" reicht es aber nicht.
mfg
(eines der seltenen Beispiele, bei denen DIM wirklich hilft)
das ist erst einmal ein eigenständiges Makro, kannst es also zusätzlich einfügen bzw. unter ein bestehendes legen. Das Makro gibt Dir Ergebnisse auch erst mal nur im Direktfenster im VBE aus, das sind die Anweisungen mit Debug.Print.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
mit der Idee von Schaun kann der Code kürzer werden, teste mal mit:
Code:
Sub V4() Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction Dim NN
Sheets(1).Activate With Sheets("Test") For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row NN = Split(Cells(i, 3), Chr(10)) VN = Split(Cells(i, 4), Chr(10)) Gb = Split(Cells(i, 5), Chr(10))
For d = 0 To UBound(Gb) If Gb(d) = "" Then Gb(d) = "not/available" Else ju = IIf(Year(Gb(d)) > ju, Year(Gb(d)), ju) Gb(d) = WSF.Text(CDate(Gb(d)), "[$-40c]DD MMMM YYYY") End If
Next d
.Cells(i + 2, 8) = ju + 18
If UBound(NN) < UBound(VN) Then ReDim Preserve NN(UBound(VN)) End If For d = 1 To UBound(NN) If NN(d) = "" Then NN(d) = NN(d - 1) Next d
For d = 0 To UBound(VN) VN(d) = WSF.Proper(NN(d)) & " " & VN(d) & " née le " & Gb(d) Next d .Cells(i + 2, 5) = Join(VN, ", ") Next i End With End Sub
Falls kein Geburtsdatum angegeben ist, sollte der Code (ungeprüft) das abfangen.
in Foren wird , im Gegensatz zu Dienstleistern, möglichst übersichtlich programmiert, also kein Fehler bzw Ausnahmenbehandlung.
Leider konnte ich den Code von gestern nicht zu einem Ein-Zeiler reduzieren, aber etwas aufräumen ging schon:
Code:
Sub V5() Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction Dim NN
Sheets(1).Activate With Sheets("Test") For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row NN = Split(Cells(i, 3), Chr(10)) VN = Split(Cells(i, 4), Chr(10)) Gb = Split(Cells(i, 5), Chr(10))
For d = 1 To UBound(VN) If NN(d) = "" Then NN(d) = NN(d - 1) ju = IIf(Year(CDate(Gb(d))) > ju, Year(CDate(Gb(d))), ju) VN(d) = WSF.Proper(NN(d)) & " " & VN(d) & " née le " & WSF.Text(CDate(Gb(d)), "[$-40c]DD MMMM YYYY") Next d
.Cells(i + 2, 1).Resize(, 8) = Split(Cells(i, 6) & "||" & Cells(i, 2) & "||" & Join(VN, ", ") & "||" & Ext & "|" & ju + 18, "|") Next i End With End Sub
in einer Liste mit Texten können viele Ausnahmen/Fehler vorkommen, die man in einem Code eigentlich nur schrittweise abfangen kann. Dies "blind" (ohne komplette Liste derMöglichkeiten) zu versuchen, wird nicht funktionieren. Wenn der Code ca 99% gut erfasst, ist es am einfachsten, den Rest von Hand einzupflegen.
Der Code prüft auf den Fehler "missing birthday" und vermeidet einen Abbruch. Falls nötig, kann man an der markierten Stelle weiteren Code einfügen.
Code:
Sub V5() Dim WSF As WorksheetFunction: Set WSF = Application.WorksheetFunction Dim G_Datum As Boolean Dim NN
Sheets(1).Activate With Sheets("Test") For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row 'If i = 9 Then Stop 'Unterbrechen in einer Zeile mit Fehler NN = Split(Cells(i, 3), Chr(10)) VN = Split(Cells(i, 4), Chr(10)) Gb = Split(Cells(i, 5), Chr(10)) '#### Fehlerbehandlung: missing Geburtsdatum G_Datum = False For d = 0 To UBound(Gb) If Not IsDate(CDate(Gb(d))) Then G_Datum = True Next d If G_Datum Or UBound(VN) > UBound(Gb) Then Range(Cells(i, 1), Cells(i, 6)).Interior.Color = vbYellow 'hier der Ersatz für die Ergebnistablle GoTo Nx End If '#### Ext = Split(Cells(i, 2), "/")(1) Jh = IIf(Val(Ext) > 50, "19", "20") Ext = Jh & Ext
If UBound(NN) < UBound(VN) Then ReDim Preserve NN(UBound(VN))
For d = 0 To UBound(VN) If d = 0 Then ju = Year(CDate(Gb(0))) If NN(d) = "" Then NN(d) = NN(d - 1) ju = IIf(Year(CDate(Gb(d))) > ju, Year(CDate(Gb(d))), ju) VN(d) = WSF.Proper(NN(d)) & " " & VN(d) & " née le " & WSF.Text(CDate(Gb(d)), "[$-40c]DD MMMM YYYY") Next d
.Cells(i + 2, 1).Resize(, 8) = Split(Cells(i, 6) & "||" & Cells(i, 2) & "||" & Join(VN, ", ") & "||" & Ext & "|" & ju + 18, "|") Nx: Next i End With End Sub
