Ich wollte den eigentlich vom TE. ;P
Option Explicit
Public Sub Datenimport()
'# Quelle und Ziel definieren
Dim QuelleWs As Excel.Worksheet
Dim ZielWs As Excel.Worksheet
Dim vFile As Variant
Set ZielWs = ActiveSheet
vFile = Application.GetOpenFilename()
If VarType(vFile) <> vbString Then Exit Sub
Set QuelleWs = Workbooks.Open(vFile).Worksheets(1)
'# Grenzen (Daten-Bereich, Quelle und Ziel) definieren
Dim Zeile As Long
Dim ZeileMaxQ As Long, SpalteMaxQ As Long
Dim ZeileMaxZ As Long
ZeileMaxQ = QuelleWs.Cells(QuelleWs.Rows.Count, "G").End(xlUp).Row
SpalteMaxQ = QuelleWs.Cells(2, "O").End(xlToRight).Column
ZeileMaxZ = ZielWs.Cells(ZielWs.Rows.Count, "F").End(xlUp).Row
'# Daten-Mittelwert in Ziel berechnen
Dim AverageK As Double
With ZielWs
AverageK = 3 * WorksheetFunction.Average(.Range(.Cells(3, "M"), .Cells(ZeileMaxZ, "M")))
End With
Application.ScreenUpdating = False
For Zeile = 4 To ZeileMaxQ
If QuelleWs.Cells(Zeile, "N") > AverageK Then
' Select Case MsgBox( _
' Prompt:="Hast du die möglichen falschen Werte überpüft?", _
' Buttons:=vbYesNo)
' Case vbYes
' MsgBox "Die Daten werden eingelesen"
' Exit For
'
' Case vbNo
QuelleWs.Cells(Zeile, "N").EntireRow.Interior.ColorIndex = 3
QuelleWs.Cells(Zeile, SpalteMaxQ + 1) = "X"
' Call QuelleWs.Range("A3:R3").AutoFilter(Field:=18, Criteria1:="X")
' Exit Sub
'
' End Select
End If
Next
Call QuelleWs.Range("A3:R3").AutoFilter(Field:=18, Criteria1:="X")
Application.ScreenUpdating = True
End Sub
Ich hab das Makro mal etwas aufgeräumt / umgeformt. So sollte es sich etwas besser lesen.
Ist der Wert in einer der Zeilen größer dem zuvor berechneten arithmetischen Mittel, dann wird die Zeile rot gefärbt und ein X wird rechts in der Zeile gesetzt.
Ich hoffe der Punkt
>> Ich will, dass das Sub erst alle Fehler findet und markiert, dass ich mir alle Fehler anschauen kann.
ist damit erfüllt.
Grüße
PS: Das Makro ist ungetestet!
|