brotherkeeper
Feb 07, 2012
view4483
view16
0
Goto Top

Fehlerprotokoll erstellen - Fehlermeldung generieren

GermansolvedQuestionMicrosoft OfficeMicrosoft
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?
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 180162

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

Printed on: April 25, 2024 at 16:04 o'clock

16 Comments
Latest comment
Goto Top
Member: bastla
bastla Feb 08, 2012 at 09:51:53 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 08, 2012 at 11:47:00 (UTC)
Goto Top
sehr cool...

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

<ALT>

<EDITIERT>
Member: brotherkeeper
brotherkeeper Feb 08, 2012 at 12:58:31 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 08, 2012 at 13:00:26 (UTC)
Goto Top
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]
Member: bastla
bastla Feb 08, 2012 at 14:53:43 (UTC)
Goto Top
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
Member: bastla
bastla Feb 08, 2012 at 15:34:12 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 09, 2012 at 09:27:10 (UTC)
Goto Top
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?
Member: bastla
bastla Feb 09, 2012 at 10:41:07 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 09, 2012 at 11:09:19 (UTC)
Goto Top
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?
Member: bastla
bastla Feb 09, 2012 at 11:33:59 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 09, 2012 at 12:46:25 (UTC)
Goto Top
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...
Member: bastla
bastla Feb 09, 2012 at 13:40:46 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 09, 2012 at 14:28:49 (UTC)
Goto Top
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
Member: bastla
bastla Feb 09, 2012 at 14:55:16 (UTC)
Goto Top
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
Member: brotherkeeper
brotherkeeper Feb 09, 2012 at 15:36:22 (UTC)
Goto Top
wohl war...

gelobe besserung...
Member: bastla
bastla Feb 09, 2012 at 15:58:10 (UTC)
Goto Top
Hallo brotherkeeper!
gelobe besserung...
Das könntest Du ja gleich in die Tat umsetzen - denn das, was Du [=5 Anleitung]" entfernt ...

Grüße
bastla
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments