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...
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
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 180310
Url: https://administrator.de/contentid/180310
Ausgedruckt am: 22.11.2024 um 19:11 Uhr