Hallo,
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.
mfg
Das heisst die 2 VBA's miteinander könnte Fehler verursachen so dass es dan besser ist das nicht zu machen
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
Hallo,
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)
Ok und wie füge ich diesen Teil jetzt in den anderen hinzu weiss nicht genau auf welcher Stelle im Vba...?
Hallöchen,
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.
Hallo,
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))
ju = 0
.Cells(i + 2, 1) = Cells(i, 6)
.Cells(i + 2, 3) = Cells(i, 2)
Ext = Split(Cells(i, 2), "/")(1)
Jh = IIf(Val(Ext) > 50, "19", "20")
Ext = Jh & Ext
.Cells(i + 2, 7) = Ext
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.
mfg
Hallo,
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))
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))
ju = Year(CDate(Gb(0)))
VN(0) = WSF.Proper(NN(0) & " " & VN(0) & " née le " & WSF.Text(CDate(Gb(0)), "[$-40c]DD MMMM YYYY"))
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
mfg
Hallo,
Fals ich kein Geburtsdatum rein setze bleibt bei mir das Makro immer noch hängen....?
Mfg
Hallo,
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
In der Datei ist mein Test-Scenario markiert.
mfg