Inhalte aufsplitten
19.07.2006 09:18:04
Monique
Ich habe ein Problem mit meinem Quellecode. Ich habe in einer Zelle verschiedene Daten zu stehen, die dann in verschiedene Zellen aufgeteilt werden.
Wenn nun der Inhalt folgenden Form 'Anmeldung: EW=2 Kinder=3 Alter=1, 11, 15' funftioniert alles problemlos. Habe ich aber nur die Angabe der Erwachsenenen 'Anmeldung: EW=2', dann werden die Kinderspalten mit 0 eingetragen, aber die Erwachsenen werden nicht übernommen. Die Spalte bleibt leer.
Kann mir vielleicht jemand weiterhelfen?
Sub Anmeldung()
Dim int1Bis6 As Integer, int7Bis12 As Integer, int13Bis18 As Integer
Dim lngLastRow As Long, lngI As Long, lngN As Long
Dim wksSheetSource As Worksheet, wksSheetTarget As Worksheet
Dim arrHelp() As String, arrAlter() As String
Set wksSheetSource = ActiveWorkbook.Worksheets("Liste")
Set wksSheetTarget = ActiveWorkbook.Worksheets("Details")
lngLastRow = wksSheetSource.Cells(Rows.Count, 2).End(xlUp).Row
For lngI = 2 To lngLastRow
wksSheetTarget.Cells(lngI, 1) = wksSheetSource.Cells(lngI, 2)
arrHelp = Split(wksSheetSource.Cells(lngI, 7), "=")
wksSheetTarget.Cells(lngI, 3) = 0
wksSheetTarget.Cells(lngI, 4) = 0
wksSheetTarget.Cells(lngI, 5) = 0
If UBound(arrHelp) > 1 Then
wksSheetTarget.Cells(lngI, 2) = CStr(Val(arrHelp(1)))
wksSheetTarget.Cells(lngI, 6) = CStr(Val(arrHelp(2)))
arrAlter = Split(arrHelp(3), ",")
If UBound(arrAlter) > 0 Then
For lngN = LBound(arrAlter) To UBound(arrAlter)
Select Case Val(arrAlter(lngN))
Case 1 To 6:
wksSheetTarget.Cells(lngI, 3) = wksSheetTarget.Cells(lngI, 3) + 1
Case 7 To 12:
wksSheetTarget.Cells(lngI, 4) = wksSheetTarget.Cells(lngI, 4) + 1
Case 13 To 18:
wksSheetTarget.Cells(lngI, 5) = wksSheetTarget.Cells(lngI, 5) + 1
Case Else
MsgBox "Sie haben Kinder älter als 18 Jahre in der Liste !", vbCritical
End Select
Next lngN
End If
End If
Next lngI
End Sub
Vielen lieben Dank.
Gruß Monique