Hi!
Nachstehend wie gewünscht mein Code:
Sub Durchführungsdatum_ändern()
Dim var01, var02 As String
Dim betrag As Variant
'##############################altes Durchführungsdatum#####################################
'Ermittlung Überweisungsbetrag:
Dim range02 As Range
Dim zelle02 As Range
Set range02 = Range("A20:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
For Each zelle02 In range02
If Right(zelle02.Offset(0, 0), 10) = "</CtrlSum>" _
And zelle02.Offset(0, 0) > 10 Then
' MsgBox "Test" & zelle02.Offset(0, 0).Address
betrag = zelle02.Offset(0, 0)
' MsgBox Betrag 'zum Testen
betrag = Left(zelle02.Offset(0, 0), Len(betrag) - 10)
betrag = betrag / 100 'Format(Betrag / 100, "#,##0.00")
Summe = Summe + betrag
' MsgBox "Betrag " & betrag & vbLf & _
' "Summe " & Summe 'zum Testen
Else
End If
Next zelle02
Set range02 = Nothing
Set zelle02 = Nothing
'vorhanden Daten ermitteln
Dim range03 As Range
Dim zelle03 As Range
Set range03 = Range("A20:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
For Each zelle03 In range03
If Right(zelle03.Offset(0, 0), 14) = "</ReqdExctnDt>" Then
Datum = Left(zelle03.Offset(0, 0), 10)
Datum_alle = Datum_alle & vbLf & Datum
Else
End If
Next zelle03
Set range03 = Nothing
Set zelle03 = Nothing
MsgBox "Folgende Daten sind derzeit vorhanden:" & vbLf & _
Datum_alle, vbInformation, "Hinweis"
nochmal01:
var01 = InputBox("Bitte altes Durchführungsdatum eingeben." & vbLf & _
"" & vbLf & _
"Überweisungsbetrag = " & Format(Summe, "#,##0.00") & vbLf & _
"", "Eingabe ALTES Durchführungsdatum", "JJJJ-MM-TT")
If var01 = "" Then GoTo Abbruch
len01 = Left(var01, 4) 'Jahr
len02 = Mid(var01, 6, 2) 'Monat
len03 = Right(var01, 2) 'Tag
dathelp01 = len03 & "." & len02 & "." & len01
'MsgBox dathelp01 'zum Testen
''Prüfung der Eingabe auf Zahlen - ab SEPA/Loga nicht mehr möglich
'If Not IsNumeric(var01) Then
' MsgBox "Bitte nur Zahlen eingeben." & vbLf & _
' "", vbExclamation, "Prüfung Zahleneingaben"
' GoTo nochmal01
'Else
'End If
'Prüfung der Länge der Zahleneingabe
If Len(var01) <> 10 Then
MsgBox "Die Zahl muss aus zehn Zeichen (JJJJ-MM-TT) bestehen!" & vbLf & _
"", vbExclamation, "Längenprüfung altes Durchführungsdatum"
GoTo nochmal01
Else
End If
'Prüfung Montaseingabe > 12
If len02 > 12 Then
MsgBox "Monatswert > 12" & vbLf & _
"Bitte Wert entsprechend korrigieren" & vbLf & _
"" & vbLf & _
"Der Makrolauf wird abgebrochen." & vbLf & _
"", vbInformation, "--> Prüfung Monatswert"
Exit Sub
Else
End If
'Prüfung, ob die Eingabe ein korrektes Datum ist
If IsDate(dathelp01) Then
If DateValue(dathelp01) = dathelp01 Then
'GoTo weiter01
Else
End If
Else
MsgBox "Kein gültiges Datum!" & vbLf & _
"Jahr: " & len01 & vbLf & _
"Monat: " & len02 & vbLf & _
"Tag: " & len03 & vbLf & _
"Der Makrolauf wird abgebrochen.", vbExclamation, "Prüfung altes Durchführungsdatum"
Exit Sub
End If
'Zählen der Ersetzung(en)
Dim range01 As Range
Dim zelle01 As Range
Set range01 = Range("A20:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
For Each zelle01 In range01
If InStr(zelle01.Offset(0, 0), var01 & "</ReqdExctnDt>") Then
anzahl01 = anzahl01 + 1
Else
End If
Next zelle01
Set range01 = Nothing
Set zelle01 = Nothing
'##############################neues Durchführungsdatum#####################################
weiter01:
nochmal02:
var02 = InputBox("Bitte neues Durchführungsdatum eingeben.", "Eingabe NEUES Durchführungsdatum", "JJJJ-MM-TT")
If var02 = "" Then GoTo Abbruch
len04 = Left(var02, 4) 'Jahr
len05 = Mid(var02, 6, 2) 'Monat
len06 = Right(var02, 2) 'Tag
dathelp02 = len06 & "." & len05 & "." & len04
'MsgBox dathelp02 'zum Testen
''Prüfung der Eingabe auf Zahlen - ab SEPA/Loga nicht mehr möglich
'If Not IsNumeric(var02) Then
' MsgBox "Bitte nur Zahlen eingeben." & vbLf & _
' "", vbExclamation, "Prüfung Zahleneingaben"
' GoTo nochmal02
'Else
'End If
'Prüfung der Länge der Zahleneingabe
If Len(var02) <> 10 Then
MsgBox "Die Zahl muss aus zehn Zeichen (JJJJ-MM-TT) bestehen!" & vbLf & _
"", vbExclamation, "Längenprüfung neues Durchführungsdatum"
GoTo nochmal02
Else
End If
'Prüfung Montaseingabe > 12
If len02 > 12 Then
MsgBox "Monatswert > 12" & vbLf & _
"Bitte Wert entsprechend korrigieren" & vbLf & _
"" & vbLf & _
"Der Makrolauf wird abgebrochen." & vbLf & _
"", vbInformation, "--> Prüfung Monatswert"
Exit Sub
Else
End If
'Prüfung, ob die Eingabe ein korrektes Datum ist
If IsDate(dathelp02) Then
If DateValue(dathelp02) = dathelp02 Then
GoTo weiter02
Else
End If
Else
MsgBox "Kein gültiges Datum!" & vbLf & _
"Jahr: " & len04 & vbLf & _
"Monat: " & len05 & vbLf & _
"Tag: " & len06 & vbLf & _
"Der Makrolauf wird abgebrochen.", vbExclamation, "Prüfung NEUES Durchführungsdatum"
Exit Sub
End If
'Ersetzungsvorgang
weiter02:
For lngZeile = 20 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(lngZeile, 1) = Replace(Cells(lngZeile, 1), var01 & "</ReqdExctnDt>", var02 & "</ReqdExctnDt>")
Next
date_var01 = DateSerial(Left$(var01, 4), Mid$(var01, 6, 2), Right$(var01, 2))
date_var02 = DateSerial(Left$(var02, 4), Mid$(var02, 6, 2), Right$(var02, 2))
If anzahl01 = 0 Then
MsgBox "Keine Übereinstimmung(en) gefunden!" & vbLf & _
"" & vbLf & _
var01 & "</ReqdExctnDt>" & vbLf & _
"durch" & vbLf & _