07.02.2012

4664

Fehlerprotokoll erstellen - Fehlermeldung generieren

Folgende Situation:
Tabelle bestehend aus einer 5x5 Matrix... Erste Spalte und erste Reihe bestehen aus "Bezeichnungen" (Reihennamen: Gelb. Blau, Rot & Schwarz und Spaltennamen: Team 1, Team 2, Team 3 & Team 4). Nun möchte ich par Makro ausgespuckt bekommen in welchen Zellen ein Wert fehlt (zB: in "<Team 1> fehlt <rot>" oder in "<Team 2> fehlt <blau> & <schwarz>").

Dies sollte in einem separat aufpoppenden Fenster angezeigt werden indem ich das ganze "nur" mit ok-button bestätigen kann (und das Fenster schließt sich wieder) oder ich per Knopfdruck exportieren kann (am liebsten in die Zwischenablage)...

Hat jemand für mich eine Lösung?

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 180162

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

Ausgedruckt am: 22.11.2024 um 20:11 Uhr

16 Kommentare

Neuester Kommentar

Hallo brotherkeeper!

Ein einfacher Ansatz könnte so aussehen:

Sub Check()
InfoSpalte = 1
InfoZeile = 1

Zeile = InfoZeile + 1
Do While Cells(Zeile, InfoZeile).Value <> ""  
    Fehler = ""  
    Spalte = InfoSpalte + 1
    Do While Cells(InfoZeile, Spalte).Value <> ""  
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(InfoZeile, Spalte).Value  
        Spalte = Spalte + 1
    Loop
    If Fehler <> "" Then Ausgabe = Ausgabe & " | " & Cells(Zeile, InfoSpalte).Value & " fehlt " & Mid(Fehler, 4)  
    Zeile = Zeile + 1
Loop
If Ausgabe <> "" Then  
    InputBox "Fehlende Angaben:", "Fehler", Mid(Ausgabe, 4)  
'Else  
'    MsgBox "Alle Daten vorhanden", vbInformation + vbOKOnly  
End If
End Sub

Da für die Ausgabe eine "InputBox" verwendet wird, kannst Du einfach per "Strg + c" oder Kontextmenü das Ergebnis in die Zwischenablage kopieren.

Die Zeilen 18 und 19 sind derzeit auskommentiert - wenn Du in jedem Fall (also auch, wenn keine Daten fehlen) eine Rückmeldung erhalten willst, einfach die Kommentarzeichen am Anfang dieser Zeilen entfernen ...

Wenn schließlich noch die Ausgaben (zumindest nach dem Einfügen im Zieldokument) nicht durch "|", sondern durch Zeilenschaltungen getrennt sein sollen, die Zeilen 12 und 16 durch

    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(Zeile, InfoSpalte).Value & " fehlt " & Mid(Fehler, 4)

und

    InputBox "Fehlende Angaben:", "Fehler", Mid(Ausgabe, 3)

ersetzen.

Grüße
bastla

sehr cool...

wie kann ich nun vorgeben in welchen bereich/range gesucht werden soll? also in meinem Beispiel innerhalb B2:E5...

<ALT>

<EDITIERT>

Anders...

Spalte A ist leer (Platzhalter)
Spalte B beinhaltet die Farben
Spalte C und D wieder leer (Platzhalter)
Spalten E bis G gefüllt mit Daten (oder auch nicht, aber das will ich ja mit dem Script herausfinden)
Spate H leer (Platzhalter)
Spalte I bis J wieder gefüllt mit Daten

Zeile 1 ist leer (Platzhalter)
Zeile 2 beinhaltet die Teamnamen
Zeile 3 und 4 wieder leer (Platzhalter)
Zeilen 5 bis 9 gefüllt mit Daten (oder auch nicht, aber das will ich ja mit dem Script herausfinden)
Zeile 10 leer (Platzhalter)
Zeilen 11 bis 12 wieder gefüllt mit Daten

Ich muss nur die Felder E5:G9 und I11:J12 nach "" prüfen...

Dein Beispiel habe ich natürlich direkt getestet... Es ist so wie ich es mit vorstelle außer das ich keinen Umbruch habe, "nur" ein doppeltes Recheck als Trennzeichen und alles in einer Reihe... Ich brauche aber eine Fehlermeldung wie:
Team 1 fehlt rot
Team 2 fehlt blau, schwarz

:-

sorry

um sicher zu gehen, dieses Script nutze ich gerade:

Sub Check()
InfoSpalte = 1
InfoZeile = 1

Zeile = InfoZeile + 1
Do While Cells(Zeile, InfoZeile).Value <> ""  
    Fehler = ""  
    Spalte = InfoSpalte + 1
    Do While Cells(InfoZeile, Spalte).Value <> ""  
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(InfoZeile, Spalte).Value  
        Spalte = Spalte + 1
    Loop
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(Zeile, InfoSpalte).Value & " fehlt " & Mid(Fehler, 4)  
    Zeile = Zeile + 1
Loop
If Ausgabe <> "" Then  
    InputBox "Fehlende Angaben:", "Fehler", Mid(Ausgabe, 3)  
'Else  
'    MsgBox "Alle Daten vorhanden", vbInformation + vbOKOnly  
End If
End Sub

[Edit Biber] Codeformatierung. [/Edit]

Hallo brotherkeeper!

Mein Beispiel ist aufgrund Deiner allgemein gehaltenen Beschreibung einfach auf die Zellen A1:E5 ausgelegt - eine Anpassung aufgrund der zusätzlichen Informationen werde ich später vornehmen ...

außer das ich keinen Umbruch habe, "nur" ein doppeltes Recheck als Trennzeichen und alles in einer Reihe...

Meine Erklärung oben scheint nicht verständlich genug gewesen zu sein - daher nochmals: Da Du die Fehlermeldung ja kopieren wolltest, habe ich die Ausgabe darauf ausgerichtet; ein Versuch, den kopierten Text zB in einem Editor oder in Word einzufügen, sollte dort auch das gewünschte Ergebnis bringen.

Mit

InputBox Mid(Ausgabe, 3), "Fehler", Mid(Ausgabe, 3)

solltest Du auch in der Anzeige die gewünschte Formatierung erhalten.

Grüße
bastla

Hallo brotherkeeper!

Ging doch etwas schneller als erwartet ...

Soferne meine Annahmen (Farben in den Zellen B5:B9 und B11:B12 und die Teamnamen in E2:G2 und I2:J2) zutreffen, sollte das etwa so gehen:

Sub Check()
InfoSpalte = 2
InfoZeile = 2

For Spalte = 5 To 7
    Fehler = ""  
    For Zeile = 5 To 9
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(Zeile, InfoSpalte).Value  
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & " fehlt " & Mid(Fehler, 4)  
Next

For Spalte = 9 To 10
    Fehler = ""  
    For Zeile = 11 To 12
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(Zeile, InfoSpalte).Value  
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & " fehlt " & Mid(Fehler, 4)  
Next

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

Grüße
bastla

Fast perfekt...

nur zwei marginale punkte:
Die fehlermeldung werden für jeden "block" neu generiert mit dem Ergebniss das sich die Fehler des Teams 1 erst in einem block und dann im anderen block gelistet werden und dabei von einem fehler des teams 2 im ersten block unterbrochen werden.
zB:
Team 1 fehlen rote shirts
Team 2 fehlen blaue shirts
Team 1 fehlen rote hosen
schön wäre entweder:
Team 1 fehlen rote shirts
Team 1 fehlen rote hosen
Team 2 fehlen blaue shirts
oder gar
Team 1 fehlen rote shirts & rote hosen
Team 2 fehlen blaue shirts

außerdem scheint es eine Zeichenlimitierung in der MessageBox zu geben welche die Fehlermeldung "kastriert"... Kann das geändert werden oder muss ich mit da mit der Zwischenablage behilflich sein?

Machbar?

Hallo brotherkeeper!

Die fehlermeldung werden für jeden "block" neu generiert

Vielleicht könntest Du die "blocks" einmal näher erläutern - ich bin immer noch auf Annahmen (s.o.) angewiesen ...

Team 1 fehlen rote shirts & rote hosen

...sollte eigentlich (innerhalb eines Blocks) bereits so aussehen ...

außerdem scheint es eine Zeichenlimitierung in der MessageBox zu geben welche die Fehlermeldung "kastriert"... Kann das geändert werden oder muss ich mit da mit der Zwischenablage behilflich sein?

Du kannst allenfalls die "InputBox" meinen; welche Limitierung meinst Du festgestellt zu haben?

Grüße
bastla

Sorry

neuer Versuch:

Ich benutze folgende Code als Beispiel:

Sub Check()
InfoSpalte = 2
InfoZeile = 2

'block 1  
'shirts  
For Spalte = 5 To 7
    Fehler = ""  
    For Zeile = 5 To 7
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(Zeile, InfoSpalte).Value  
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & " fehlt " & Mid(Fehler, 4)  
Next

'block 2  
'hosen  
For Spalte = 5 To 7
    Fehler = ""  
    For Zeile = 7 To 9
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(Zeile, InfoSpalte).Value  
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & " fehlt " & Mid(Fehler, 4)  
Next

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

da bekomme ich die Fehlermeldung:
Team 1 fehlen shirts
Team 2 fehlen shirts
Team 1 fehlen hosen

Da ich die Auflstung brauche "was fehlt Team 1 und was fehlt Team 2?" wäre eine Auflistung wie folgt gewünscht:
Team 1 fehlen shirts
Team 1 fehlen hosen
Team 2 fehlen shirts
oder gar
Team 1 fehlen shirts & hosen
Team 2 fehlen shirts

Der von mir zu prüfender Bereich ist ziemlich gross und die bezeichnungen statt "Team 1", "Team 1", "shirts", "hosen", usw sind größer (bedeutet mehr Zeichen)... In der sich mir anschließend zeigende Fehlermeldung (im separatem Fenster aufpoppende Fenster) ist diese "aber" beschnitten und wird nicht ganz dargestellt. Die Zeile die ich per Gutenberg exportieren kann ist aber vollständig. Daraus schließe ich, daß es im Popup-Fenster ein Zeichenlimitierung gibt... Kann ich die aufheben/umgehen/anders lösen?

Hallo brotherkeeper!

Die Teamnamen stehen demnach nur in den Spalten E:G? Wenn ja, ändere die Zeile 9 auf

    For Zeile = 5 To 9

und entferne die Zeilen 15 bis 24.

Hinsichtlich der Ausgabe: Wenn nur eine Bildschirmanzeige genügt, versuch es anstelle der Zeile 26 mit

MsgBox Mid(Ausgabe, 3), vbInformation + vbOKOnly

Wenn beide Möglichkeiten erhalten bleiben sollen, verwende auch die "alte" Zeile 26 weiterhin.

Grüße
bastla

das ist es jetzt noch nicht ganz... Denn er prüft jetzt einzelne Zeilen die als Platzhalter dienen und spuckt mir diese natürlich auch als Fehlerhaft aus... Das war der Grund für meine "Blöcke"...

gegenwärtiger Code:

Sub Del0()
    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

InfoSpalte = 2
InfoZeile = 1

'block 1  
'shirts  
For Spalte = 5 To 17
    Fehler = ""  
    For Zeile = 4 To 62
        If Cells(Zeile, Spalte).Value = "" Then Fehler = Fehler & " & " & Cells(Zeile, InfoSpalte).Value  
    Next
    If Fehler <> "" Then Ausgabe = Ausgabe & vbCrLf & Cells(InfoZeile, Spalte).Value & " fehlt " & Mid(Fehler, 4)  
Next

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

Die Zeile 22 und 44 in Excel sind optische Platzhalter mit leeren Zellen...

wie machen?

Das Fenster-"Problem" ist allerdings gelöst...

Hallo brotherkeeper!

Die Eckdaten (seinerzeit ging es noch um eine "5x5 Matrix") ändern sich bei Dir ja mit beinahe jedem Kommentar ...

Um die Zeilen 22 und 44 zu ignorieren, könnte das etwa so gehen:

Sub Del0()
    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

InfoSpalte = 2
InfoZeile = 1

'block 1  
'shirts  
For Spalte = 5 To 17
    Fehler = ""  
    For Zeile = 4 To 62
        Select Case Zeile
            Case 22, 44
            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 & " fehlt " & Mid(Fehler, 4)  
Next

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

Grüße
bastla

Sehr geil... läuft alles genauso wie benötigt... Anbei der vollständige Code (für den der sowas auch mal brauch):

Sub Del0()
    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

InfoSpalte = 2
InfoZeile = 1

For Spalte = 5 To 17
    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
            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

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

Ich wollte eigentlich mit der 5x5 matrix das problem so einfach wie möglich beschreiben (ist mir anscheinend nur suboptimal gelungen)

Viele Grüße

B

PS: Vielen Dank an Bastla

Hallo brotherkeeper!

Ich wollte eigentlich mit der 5x5 matrix das problem so einfach wie möglich beschreiben

Rücksichtnahme ist ja was Schönes, aber retrospektiv hätten wir uns, bei einer vollständigen Beschreibung von Anfang an, einiges ersparen können ...

Grüße
bastla