MsgBox nach If-Wert mit 2ter If-Schleife
05.03.2021 10:01:08
Dennis
ich benötige mal kurz eure Hilfe. Den unten stehenden Code habe ich geschrieben, welcher aus funktioniert. Nun wollte ich einen Hinweis einbauen, dass wenn Ende minus Start > 53 (wegen Kalenderwochen) gefragt wird, ob es korrekt ist. Leider hakt es bei mir hier. Wenn ja, soll das Makro normal ausgeführt werden. Wenn nein dann wieder zurück zur Eingabe.
Vielen Dank vorab.
Viele Grüße
Dennis
Private Sub CommandButton1_Click()
Set th = Worksheets("H")
Set tb = Worksheets("B")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
tb.Cells(2, 4) = ComboBox1.Value & ComboBox2.Value
tb.Cells(3, 4) = ComboBox3.Value & ComboBox4.Value
Start = tb.Cells(2, 4).Value
Ende = tb.Cells(3, 4).Value
If Ende 53 Then
MsgBox("Der gewählte Zeitbereich ist größer als 1 Jahr. Ist das korrekt?", _
vbYesNo) = vbYes
If vbYes Then
With tb
.Range("D5:AZ100").ClearContents
.Range("D5:AZ100").Borders.LineStyle = -4142
.Cells(2, 3) = "KW " & ComboBox1.Value & " " & ComboBox2. _
Value
.Cells(3, 3) = "KW " & ComboBox3.Value & " " & ComboBox4. _
Value
End With
With th
Zeilemax = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
vntStart = Application.Match(Start, th.Rows(2), 0)
vntEnde = Application.Match(Ende, th.Rows(2), 0)
.Range(.Cells(4, 1), .Cells(Zeilemax, 1)).Copy
ThisWorkbook.Worksheets("B").Range("D6").PasteSpecial _
xlPasteValues
Application.CutCopyMode = False
.Range(.Cells(3, vntStart), .Cells(Zeilemax, vntEnde)).Copy
ThisWorkbook.Worksheets("B").Range("E5").PasteSpecial _
xlPasteValues
Application.CutCopyMode = False
End With
With tb
lngRowMax = .Cells(Rows.Count, 4).End(xlUp).Row + 1
For n = 5 To lngRowMax
n = n + 1
Spaltemax = .Cells(5, .Columns.Count).End( _
xlToLeft).Column
Set rngBereich = Range(tb.Cells(n, 4), tb. _
Cells(n, Spaltemax))
With rngBereich.Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
Next n
Set rngBereich = Range(tb.Cells(5, 4), tb.Cells( _
lngRowMax, 4))
With rngBereich.Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With
End With
Else:
Exit Sub
End If
Else:
Exit Sub
End If
End If
Unload Me
End Sub
Anzeige