brotherkeeper
Goto Top

Fehlerprotokoll erstellen (Zellen nach leeren Inhalt prüfen und Fehlermeldung in einem Fenster auspucken) - Vorher von falschen Werten bereinigen

Dank Bastla konnte ich folgendes Script erstellen...

Wer es gebrauchen kann, bitte laden...

Sub Del0()
'Bereinigung von falschen Daten  
    Range("E4:Q63").Select  
    Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _  
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="0%", Replacement:="", LookAt:=xlWhole, _  
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="#DIV/0!", Replacement:="", LookAt:=xlWhole, _  
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
      Range("E4").Select  
    Application.CutCopyMode = False
    For Each Cell In Range("E47:Q49").Cells  
    If Cell.Value < 60 Then Cell.Value = ""  
Next

'check nach leeren Zellen  
InfoSpalte = 2
InfoZeile = 1

For Spalte = 5 To 17 'Spalte E bis Q  
    Fehler = ""  
    For Zeile = 4 To 62
        Select Case Zeile
            Case 9, 10, 11, 14, 18, 19, 21, 22, 23, 28, 29, 30, 34, 38, 40, 42, 44, 46, 50, 54, 57, 60 'Auszulassende Zeilen innerhalb des Prüfungsbereiches  
            Case Else
                If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & ";" & Cells(Zeile, InfoSpalte).Value  
        End Select
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & ": " & Mid(Fehler, 2)  
Next

'Ausgabe in Fenster  
If Ausgabe <> "" Then  
   MsgBox Mid(Ausgabe, 3), vbInformation + vbOKOnly
'Else  
'    MsgBox "Alle Daten vorhanden", vbInformation + vbOKOnly  
End If
Calculate
End Sub

Content-Key: 180310

Url: https://administrator.de/contentid/180310

Printed on: April 24, 2024 at 04:04 o'clock