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, 13:04 (Dieser Beitrag wurde zuletzt bearbeitet: 19.10.2018, 13: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
