allg. VBA-Frage

Question

Hallo zusammen!

Gibt es eine Möglichkeit nur einen bestimmten Bereich z. B. nur den markierten Bereich eines Codes auszuführen?

Ciao

Tom

Answer 1

Hallo Tom,

Ja, Selection

Gruß Hajo

Answer 2

Hallo Hajo!

Danke für Deine Rückmeldung.

Nicht, dass ich mich unklar ausgedrückt habe:
Ich möchte in einem Code nur einen Teil davon zum Testen ausführen.
Range(A1:A10).select oder so ähnlich war nicht gemeint.

Ciao

Tom

Answer 3

Hi Tom,

Select und Selection sind 2 unterschiedliche Dinge - Select markiert einen Bereich und Selection ist der markierte Bereich, also ein Range.

Bis später,
Karin

Answer 4

Hallo Tom,

nur wenige sehen Deinen Code und sehen damit was Du machen möchtest.
Range(A1:A10).interior.color=255

Gruß Hajo

Answer 5

Hallo Tom,

eigentlich ist die kleinste logische Einheit eine Methode (Sub, Function, Property...). Einen Teil des Codes z.B. zu markieren und nur diesen auszuführen, geht nicht. Aber Du kannst einen Haltepunkt setzen und dann den Code im Einzelschritt-Modus durchlaufen lassen, um zu sehen, wass da im Einzelnen passiert. (Debugging).
Prinzipiell könntest Du das innerhalb dieser kleinsten Einheiten aber auch mit Kontrollstrukturen bewältigen (If-Else..., Select Case, unter bestimmten Bedingungen auch in Schleifen).

Für die Verwendung von Kontrollstrukturen ganz einfach z.B.:

If Testbedingung=Wert then
... zu testenden Code hier ausführen ...
else
... hier alle anderen Anweisungen
End if

Die Testbedingung könnte dann zum Beispiel aus einem Tabellenblatt ausgelesen werden bzw. in einer Variable/Konstante im Code-Modul definiert werden.

Weiterhin gibt es die Möglichkeit bedingter Kompilierung. Dann würde der Code etwa so aussehen:

#If TESTBEDINGUNG=-1 then
... zu testenden Code hier ausführen ...
#else
... hier alle anderen Anweisungen
#End if

Dafür müsstest Du eine Debug-Konstante definieren:
Im VBA-Projekt Extras->Eigenschaften von VBA-Projekt...
-> Im Dialogfeld dann im Feld "Argumente für bedingte Kompilierung" für diesen Fall

TESTBEDINGUNG = -1

eingeben.

Dieses Vorgehen hat den Vorteil, dass wie im obigen Beispiel der Code im #else-Zweig überhaupt nicht erst kompiliert wird, also für das VBA-Projekt in diesem Fall nicht sichtbar ist.

Prinzipiell scheint mir Deine Frage aber noch auf ein anderes Problem hinzuweisen:
Spaghetti-Code!
Versuche nicht, in einer Methode (Sub oder Function) alles mögliche zu erledigen. Viel besser und sinnvoller ist es, logisch zusammengehörige Anweisungen in einzelne Methoden zu kapseln und diese dann aus größeren Zusammenhängen wie Bausteine zusammenzufügen/aufzurufen.
Dadurch wird Dein Code lesbarer und pflegbarer, last not least aber auch wiederverwendbar.
Ein Beispiel wäre eine Methode, die einen Bereich in einen anderen Bereich kopiert:

Function copyRange(Source As Range, Target As Range) As Boolean
On Error resume next
... Kopieranweisungen (selbermachen ;-))...
If Err.Number <> 0 then
... Fehlermeldung ausgeben ...
copyRange = False
Exit Function
End if
copyRange = True
End Function

Sowas ist gezielt testbar und kann auch von anderen Programmteilen verwendet werden. Die Lesbarkeit des Codes gewinnt auch, in dem Du für Deine Methoden dann sprechende Namen vergeben kannst. Oder findest Du nicht, dass der Name der Function schon nahelegt, was damit beabsichtigt wird? ;-) - Viel Spaß beim coden!

Gruß
Al Rinat

Answer 6

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 & _