Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

"Zu früher" If Abbruch VBA

Betrifft: "Zu früher" If Abbruch VBA von: Himmelerde
Geschrieben am: 30.09.2020 13:56:15

Hallo liebes Forum,

ich habe den folgenden Code(ausschnitt):
Mein Problem liegt beim Fall "If iClick = vbNo". Er bricht die Suche nach dem ersten Erfüllen der IF Bedingung "WB.Sheets(1).Cells(Zeile, 14) “größer als“ 3 * AveragePD“ ab. Er sucht nicht nach weiteren Werten, die diese Bedingung erfüllen können. Es wird nicht das ganze Arbeitsblatt nach den "fehlerhaften" Werten untersucht. Sobald eine Zeile/Wert die Bedingung erfüllt, wird die Suche abgebrochen.

Sub Datenimport()

Dim WB, As Workbook, AveragePD As Double, lr, lr1 As Long, wksZIEL As Worksheet,
Dim Zeile As Long
Dim vFile As Variant
Set wksZIEL = ActiveSheet
Zeile = 3

vFile = Application.GetOpenFilename
If vFile = False Then Exit Sub
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 6).End(xlUp).Row + 1
Set WB = Workbooks.Open(vFile)
lr1 = wksZIEL.Cells(Rows.Count, 6).End(xlUp).Row + 1
lr = WB.Sheets(1).Cells(Rows.Count, 7).End(xlUp).Row
Spalte = 15
Zeile = 4
Zeilewks = lr1
ls = WB.Sheets(1).Cells(2, 15).End(xlToRight).Column
AveragePD = wksZIEL.Application.WorksheetFunction.Average(wksZIEL.Range(wksZIEL.Cells(3, 13), wksZIEL.Cells(lr1 - 1, 13)))

For Zeile = Zeile To lr
If WB.Sheets(1).Cells(Zeile, 14) “größer als“ 3 * AveragePD Then
iClick = MsgBox( _
prompt:="Hast du die möglichen falschen Werte überpüft?", _
Buttons:=vbYesNo)
If iClick = vbNo Then
WB.Sheets(1).Cells(Zeile, 14).EntireRow.Interior.ColorIndex = 3
WB.Sheets(1).Cells(Zeile, ls + 1) = "X"
WB.Sheets(1).Range("A3:R3").AutoFilter Field:=18, Criteria1:="X"
Exit Sub
ElseIf iClick = vbYes Then
MsgBox "Die Daten werden eingelesen"
Exit For
End If
End If
Next

Vielen Dank für die Hilfe!

Betrifft: AW: "Zu früher" If Abbruch VBA
von: Rudi Maintaire
Geschrieben am: 30.09.2020 13:59:10

dann solltest du Exit Sub löschen.

Betrifft: AW: "Zu früher" If Abbruch VBA
von: Himmelerde
Geschrieben am: 30.09.2020 16:30:24

Das ist leider keine Lösung. Das Sub ist noch deutlich größer es soll dann enden, wenn solche Werte vorkommen. Es soll allerdings erst enden, wenn alle "fehlerhaften" Werte gefunden sind.

Betrifft: AW: "Zu früher" If Abbruch VBA
von: Himmelerde
Geschrieben am: 30.09.2020 16:31:43

Hallo liebes Forum,

ich habe den folgenden Code(ausschnitt):
Mein Problem liegt beim Fall "If iClick = vbNo". Er bricht die Suche nach dem ersten Erfüllen der IF Bedingung "WB.Sheets(1).Cells(Zeile, 14) “größer als“ 3 * AveragePD“ ab. Er sucht nicht nach weiteren Werten, die diese Bedingung erfüllen können. Es wird nicht das ganze Arbeitsblatt nach den "fehlerhaften" Werten untersucht. Sobald eine Zeile/Wert die Bedingung erfüllt, wird die Suche abgebrochen.

Sub Datenimport()

Dim WB, As Workbook, AveragePD As Double, lr, lr1 As Long, wksZIEL As Worksheet,
Dim Zeile As Long
Dim vFile As Variant
Set wksZIEL = ActiveSheet
Zeile = 3

vFile = Application.GetOpenFilename
If vFile = False Then Exit Sub
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 6).End(xlUp).Row + 1
Set WB = Workbooks.Open(vFile)
lr1 = wksZIEL.Cells(Rows.Count, 6).End(xlUp).Row + 1
lr = WB.Sheets(1).Cells(Rows.Count, 7).End(xlUp).Row
Spalte = 15
Zeile = 4
Zeilewks = lr1
ls = WB.Sheets(1).Cells(2, 15).End(xlToRight).Column
AveragePD = wksZIEL.Application.WorksheetFunction.Average(wksZIEL.Range(wksZIEL.Cells(3, 13), wksZIEL.Cells(lr1 - 1, 13)))

For Zeile = Zeile To lr
If WB.Sheets(1).Cells(Zeile, 14) “größer als“ 3 * AveragePD Then
iClick = MsgBox( _
prompt:="Hast du die möglichen falschen Werte überpüft?", _
Buttons:=vbYesNo)
If iClick = vbNo Then
WB.Sheets(1).Cells(Zeile, 14).EntireRow.Interior.ColorIndex = 3
WB.Sheets(1).Cells(Zeile, ls + 1) = "X"
WB.Sheets(1).Range("A3:R3").AutoFilter Field:=18, Criteria1:="X"
Exit Sub
ElseIf iClick = vbYes Then
MsgBox "Die Daten werden eingelesen"
Exit For
End If
End If
Next

Vielen Dank für die Hilfe!

Betrifft: AW: "Zu früher" If Abbruch VBA
von: onur
Geschrieben am: 30.09.2020 17:12:06

"Das ist leider keine Lösung" - ist das deine Expertenmeinung oder hast du es getestet?
Falls du es doch getestet hast - was genau läuft immer noch falsch?

Betrifft: AW: "Zu früher" If Abbruch VBA
von: Himmelerde
Geschrieben am: 05.10.2020 12:57:17

Wenn ich es weiterlaufen lasse, läuft das Sub ja weiter und das will ich ja nicht. Ich will, dass das Sub an dem Punkt beendet, aber erst wenn alle Fehler gefunden wurden.