Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1248to1252
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Codefehler

Codefehler
WalterK
Hallo,
mit Hilfe verschiedener Anfragen habe ich folgenden Code zusammen gestellt. Allerdings läuft er nicht so wie er sollte. Eigentlich funktioniert nur Punkt 1, den Rest habe ich vermutlich falsch zusammen gesetzt.
Die Idee ist folgende:
1.) Suche in Zeile 2 die Überschrift BEZEICHNUNG. Wenn die Überschrift BEZEICHNUNG vorhanden ist, gehe zu 2, ansonsten soll der Code mit der MsgBox abbrechen.
2.) Prüfe, ob in der Spalte BEZEICHNUNG mindestens 1mal eine Hintergrundfarbe vorhanden ist. Wenn mindesten 1 Hintergrundfarbe vorhanden ist, gehe zu 3, ansonsten soll der Code mit der MsgBox abbrechen.
3.) Formatiere alle Zellen mit den gleichen Texten mit der gleichen manuell vergebenen Hintergrundfarbe.
4.) Formatier die Spalten JÄNNER bis DEZEMBER mit der in der Spalte BEZEICHNUNG vergebenen Hintergrundfarbe.
Hier noch der Code: Option Explicit Sub LK_einfärben() Dim rngBezeich As Range Dim Zelle As Range Dim myDic As Object Set myDic = CreateObject("scripting.Dictionary") Dim Rng As Range, MyBool As Boolean, lngBezeich As Long, lngrow As Long, lngBeginn As Long, _ lngEnde As Long With ActiveSheet On Error GoTo ErrExit Application.ScreenUpdating = False lngrow = Cells(Rows.Count, 3).End(xlUp).Row lngBezeich = Application.Match("BEZEICHNUNG", Rows(2), 0) lngBeginn = Application.Match("JÄNNER", Rows(2), 0) lngEnde = Application.Match("DEZEMBER", Rows(2), 0) Set rngBezeich = Intersect(.Range("A2").CurrentRegion, .Rows(2).Find("BEZEICHNUNG"). _ EntireColumn) For Each Rng In Range(Cells(3, lngBezeich), Cells(lngrow, lngBezeich)) If Rng.Interior.ColorIndex xlNone Then MyBool = True Next If MyBool Then GoTo ErrExit For Each Zelle In rngBezeich If Not myDic.exists(Zelle.Value) Then myDic(Zelle.Value) = Zelle.Interior.Color Else: Zelle.Interior.Color = myDic(Zelle.Value) End If Next For lngrow = 3 To Cells(Rows.Count, lngBezeich).End(xlUp).Row Range(Cells(lngrow, lngBeginn), Cells(lngrow, lngEnde)).Interior.ColorIndex _ = Cells(lngrow, lngBezeich).Interior.ColorIndex Next End With ErrExit: If Err.Number 0 Then MsgBox "FEHLER: Das Makro wurde vorzeitig beendet, weil entweder: " & vbCr & "" & vbCr & " _ 1.) in Zeile 2 die Überschrift BEZEICHNUNG fehlt oder " & vbCr & "" & vbCr & " 2.) in der Spalte darunter nicht mindestens eine (1) Zelle farblich hinterlegt ist!" ', vbCritical End If Set myDic = Nothing Set rngBezeich = Nothing End Sub
https://www.herber.de/bbs/user/78764.xls
Besten Dank für die Hilfe, Servus Walter

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Codefehler
06.02.2012 19:36:40
Dirk
was willst du mit der ersten Scheife bezwecken?
        For Each Rng In Range(Cells(3, lngBezeich), Cells(lngrow, lngBezeich))
If Rng.Interior.ColorIndex  xlNone Then MyBool = True
Next
und was willst du damit machen?

If MyBool Then GoTo ErrExit

if Mybool =True oder False?
if = wenn du fragst doch immer nur eine Bedingung ab ist Mybool =? dann mache
einer Abrafe if Mybool then läuft immer auf positiv also goto
dann kann da auch nix mehr pssieren.
Korrigier erstmal die If Abfrage und schau ob dann alles läuft.
Gruß
Dirk
Anzeige
nur ein If-Fehler ;o)
06.02.2012 19:51:20
Matthias
Hallo Dirk
und was willst du damit machen?
Ganz einfach.
Die Schleife durchläuft einen Bereich, wenn mind 1x eine Zellhintergrundfarbe vorhanden ist wird die Variable auf True gesetzt.
Jetzt könnte sogar noch Exit For eingepflegt werden. sobald MyBool=True ist.
Den Code habe ich ihm gepostet in einem anderen Beitrag
https://www.herber.de/forum/archiv/1248to1252/t1249333.htm#1249337
Nur habe ich ja dort keinen echten VBA-Fehler produziert den Walter nun in seiner Datei
aber mit If Err.Number0 abfragt. Deshalb kommt auch die MsgBox nicht.
Gruß Matthias
Anzeige
@Dirk
06.02.2012 20:01:00
Josef

Hallo Dirk,
nichts für ungut, aber du verzapfst hier ziemlichen Nonsense!

« Gruß Sepp »

AW: @Dirk
06.02.2012 21:27:18
Dirk
ich halt mich raus Ok :-D
ich war gerade etwas verwirrt von dem Code.
Das eine If abfrage ohne Vergleich funktioniert war mit neu.
bei der Ersten Aussage muss ich mich wirklich entnschuldigen
Bin schon weg
Dirk
Anzeige
AW: @Dirk
06.02.2012 21:45:09
Josef

Hallo Dirk,
du brauchst dich nicht raus halten, aber bitte keinen Blödsinn verzapfen, der den Hilfesuchenden mehr verwirrt als das er ihm hilft. Und deine Code-Beispiele sind auch nicht gerade das gelbe vom Ei.

« Gruß Sepp »

So, so, dabei ist das doch logisch, weil ...
07.02.2012 16:49:59
Luc:-?
…es schließlich nur darauf an-, was dabei rauskommt, Dirk!
Statt If Rng.Interior.ColorIndex xlNone Then MyBool = True könnte man übrigens auch MyBool = Rng.Interior.ColorIndex xlNone schreiben. Nur bei Fehlerprüfungen geht das so nicht, weil die Fehlerauslösung da stört (→ natürl dann in Kombi mit On Error Resume Next): If IsError(operation_xyz) Then ErrBool = True
Gruß Luc :-?
PS: Nochmal, nicht so nuscheln! Gerade, wenn's auf Verständlichkeit besonders ankommt… ;-)
Anzeige
Err.Number<>0 ?
06.02.2012 19:40:53
Matthias
Hallo Walter
Was ergibt denn bei Dir MsgBox Err.Number wenn eine Farbe vorhanden ist?
wenn Du das mal so testest;
MsgBox Err.Number
, wird Dir sicher einiges klarer. ;o)


achso und soll die Meldung wirklich so sein ?
Userbild
Gruß Matthias
AW: Err.Number<>0 ?
06.02.2012 19:55:04
Dirk
ich Glaub das müssen wir ihm etwas mehr erläutern.
ein Msgbox (Meldung) kannst du immer ausgeben wenn du magst.
das deine Zelle Farbig ist löst eigendlich keine Codefehler aus.
in der Passage if Err.Number 0 then
Fragst du ab ob ein Codefehler vorliegt.
davon würde ich abraten.
in deinem Code hast du ja folgende Passage
For Each Rng In Range(Cells(3, lngBezeich), Cells(lngrow, lngBezeich))
If Rng.Interior.ColorIndex  xlNone Then MyBool = True
Next
If MyBool Then GoTo ErrExit

hier fragst du ja jede Einzelne Zelle ab ob die Farbig ist und gibst dann Mybool ein Wahr und fragst das dann direct ab.
kürz das ganze lieber auf das hier ein.
For Each Rng In Range(Cells(3, lngBezeich), Cells(lngrow, lngBezeich))
If Rng.Interior.ColorIndex  xlNone Then
MsgBox "FEHLER: Das Makro wurde vorzeitig beendet, weil entweder: " & vbCr & "" & vbCr & "  _
1.) in Zeile 2 die Überschrift BEZEICHNUNG fehlt oder " & vbCr & "" & vbCr & " 2.) in der  _
Spalte darunter nicht mindestens eine (1) Zelle farblich hinterlegt ist!" ', vbCritical
end
End If
Next
dann vergehst du dich nicht an den Fehlermeldungen
Anzeige
AW: Err.Number<>0 ?
06.02.2012 19:57:34
WalterK
Hallo,
gewollt ist es so, dass der Code abbricht und die MsgBox erscheint (also beides zusammen), wenn a.) die Überschrift Bezeichnung fehlt oder b.) wenn in der Spalte Bezeichnung nirgends eine Hintergrundfarbe ist.
Wenn kein Fehler vorhanden ist, soll Punkt 3 und 4 durchlaufen.
Mit meinen mehr als bescheidenen VBA-Kenntnissen habe ich einfach versucht, aus verschiedenen Beiträgen meinen Code zusammen zustellen.
Danke uns Servus, Walter
Ist das Dein Wunsch ?
07.02.2012 16:16:27
Matthias
Hallo Walter
Tabelle2

 ABCDEFGHIJKLM
2Überschr1Überschr2BezeichnungGESAMTÜberschr5JÄNNERÜberschr7Überschr8Überschr9DEZEMBERÜberschr11Überschr12Überschr13
3Suppe ABC0         
4Suppe CDE0         
5Suppe JKLK10  10      
6Suppe MS0         
7Suppe OPQ20  20      
8Birne ABC40  40      
9Birne POL          
10Birne RTS60   60     
11Birne JKLK70   70     
12Birne MS8   8     
13Birne OPQ8   8     
14Birne ZWF7   7     
15Birne UFG7   7     
16Apfel ABC7      7  
17Apfel MS0         
18Apfel JKLK3      3  
19Apfel ABC2      2  
20Apfel JKLK0         


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Fehlt in Zeile(2) die Überschrift "Bezeichnung"
oder
sind bei vorhandener Überschrift "Bezeichnung" die relevanten Zellen darunter alle ohne Hintergrundfarbe ...
... gibts die MsgBox
dann probiers mal so:
https://www.herber.de/bbs/user/78777.xls
Gruß Matthias
Anzeige
AW: Ist das Dein Wunsch ?
07.02.2012 17:38:02
WalterK
Hallo Matthias,
ich bedanke mich für Deine Hilfe, jetzt läuft der Code genau so wie ich es wollte.
Servus, Walter
PS: Danke auch an Dirk für seine sicherlich gutgemeinte Hilfe.
Gern geschehen :-) oT
07.02.2012 17:50:37
Matthias

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige