Hallo Martin,
ich weiß nicht, inwieweit erstens meine Lösung deinen Vorstellungen
entspricht und zweitens du mit deinen erklärtermaßen geringen VBA-
Kenntnissen in der Lage bist, sie anzuwenden, hoffe aber, dass sie
dir ein Stück weiterhilft.
Die Function GetSB befüllt ein Array mit einem benutzerdefinierten
Datentyp mit den erkannten Schaltzeiten. Die Untergrenze des Arrays
ist immer 1, die Obergrenze ist der Rückgabewert der Function. Der
UDT (User Defined Type) namens Schaltbefehl wird mit der Type-Anweisung
erstellt und anschließend ein dynamisches Datenfeld sb() mit diesem Typ
deklariert. Der auszuwertende String wird ByVal übergeben, so dass die
Änderungen keine Auswirkung auf den Originalstring haben. Wenn bei der
Auswertung ein Fehler im übergebenen String festgestellt wird, bricht
die Function mit einer Fehlermeldung ab, da es normalerweise besser ist,
gar keine Information zu haben als eine falsche. In diesem Fall wird
der Wert 0 zurückgegeben.
In der Sub Test hast du ein einfaches Anwendungsbeispiel, das die
ermittelten Schaltbefehle aus deinem Beispielstring in das aktive
Tabellenblatt einträgt. Der komplette Code gehört in ein Modul.
Type Schaltbefehl
Wochentag As String
Zeit As Date
Befehl As String
End Type
Public sb() As Schaltbefehl
Public Function GetSB(ByVal CtrlString As String) As Long
Dim v As Variant, v1 As Variant, i As Long, j As Long
' erste 3 und letzte 3 Klammern entfernen:
CtrlString = Mid$(CtrlString, 4, Len(CtrlString) - 6)
' alle öffnenden Klammern entfernen:
CtrlString = Replace(CtrlString, "{", "")
' String in Tage splitten:
v = Split(CtrlString, "}}")
ReDim sb(0)
' jeden Tag in Befehle splitten:
For i = 0 To UBound(v)
v1 = Split(v(i), "}")
For j = 0 To UBound(v1)
ReDim Preserve sb(UBound(sb) + 1)
sb(UBound(sb)).Wochentag = WeekdayName(i + 1, False, 2)
If IsDate(Left$(Trim$(v1(j)), 8)) Then
sb(UBound(sb)).Zeit = Left$(Trim$(v1(j)), 8)
Else
Fehler
GetSB = 0
Exit Function
End If
Select Case Right$(Trim$(v1(j)), 1)
Case "1"
sb(UBound(sb)).Befehl = "Ein"
Case "2"
sb(UBound(sb)).Befehl = "Aus"
Case Else
Fehler
GetSB = 0
Exit Function
End Select
Next j, i
GetSB = UBound(sb)
End Function
Public Sub Fehler()
MsgBox "Der übergebene Steuerbefehl ist fehlerhaft!", _
vbOKOnly + vbExclamation, "Fehler"
End Sub
Sub Test()
Dim l As Long, i As Long
l = GetSB("{{{04:00:00:00, [2] 1}{17:00:00:00, [2] " & _
"2}}{{04:00:00:00, [2] 1}{17:00:00:00, [2] " & _
"2}}{{04:00:00:00, [2] 1}{17:00:00:00, [2] " & _
"2}}{{04:00:00:00, [2] 1}{17:00:00:00, [2] " & _
"2}}{{04:00:00:00, [2] 1}{17:00:00:00, [2] " & _
"2}}{{04:00:00:00, [2] 1}{17:00:00:00, [2] 2}}}")
If l > 0 Then
Columns(1).NumberFormat = "@"
Columns(2).NumberFormat = "hh:mm:ss"
Columns(3).NumberFormat = "@"
For i = 1 To l
Cells(i, 1) = sb(i).Wochentag
Cells(i, 2) = sb(i).Zeit
Cells(i, 3) = sb(i).Befehl
Next i
End If
End Sub
Wenn du dazu Fragen hast, melde dich noch mal.
Gruß
|