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!