Suche nach farbigen Zellen

Question

Hallo,
es würde mich freuen, wenn mir jemand bei meinem Problem weiterhelfen kann.

Ich habe 2 Tabellen.

In der Ersten stehen die Artikelnummern untereinander.
In der Zweiten stehen auch die Artikelnummern untereinander aber in einer anderen Reihenfolge (bzw. es sind Artikelnummern vorhanden, die in der ersten Tabelle noch nicht aufgeführt sind), sowie der Fortschritt des Bearbeitungszustands nebeneinander. Bei jedem abgeschlossenen Arbeitsgang ist die Zelle grau dargestellt und die rechts danebenliegenden ist rot. Also in unterschiedlichen Spalten.

Jetzt möchte ich, dass mir der Wert des ersten roten Feldes nach dem Grauen(aus der zweiten Tabelle) in der ersten Tabelle in der Spalte der Artikelnummer ausgegeben wird. Ähnlich der SVERWEIS-Funktion allerdings mit variierenden Spalten und nach Farben suchen.

tacker914

Answer 1

Hallo tacker914,

hier mein Vorschlag:

Sub Auswertung()
Dim lngLetzte1 As Long, lngZ1 As Long, lngZ2 As Long, lngZANr As Long
Dim intMehrfachANr As Integer, intS2 As Integer
Dim strANr As String
Dim rngSuche2 As Range
Dim blnWeiterSuchen As Boolean

Worksheets("Tabelle1").Activate
lngLetzte1 = Cells(Rows.Count, 1).End(xlUp).Row
For lngZ1 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
strANr = CStr(Cells(lngZ1, 1).Value)
If strANr <> "" Then
With Worksheets("Tabelle2").Range("A1:A" & Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1)
Set rngSuche2 = .Find(strANr, LookIn:=xlValues)
intMehrfachANr = 0
If Not rngSuche2 Is Nothing Then
lngZANr = rngSuche2.Row
Do
intMehrfachANr = intMehrfachANr + 1
Set rngSuche2 = .FindNext(rngSuche2)
blnWeiterSuchen = False
If (Not rngSuche2 Is Nothing) Then If (rngSuche2.Row <> lngZANr) Then blnWeiterSuchen = True
Loop While blnWeiterSuchen
If intMehrfachANr > 1 Then
MsgBox "Die Artikelnummer " & strANr & " wurde " & CStr(intMehrfachANr) & "-mal gefunden!", , _
"Fehler: Mehrfache Artikelnummer in Tabelle2"
Else
'erste rote Zelle in Tabelle2 in Zeile lngZANr suchen
intS2 = 2
Do
If Worksheets("Tabelle2").Cells(lngZANr, intS2).Interior.ColorIndex = 22 Then
'nachfolgende MsgBox kann gelöscht/auskommentiert werden (3 Zeilen!)
MsgBox "ColorIndex = " & Worksheets("Tabelle2").Cells(lngZANr, intS2).Interior.ColorIndex & _
Chr(10) & "Wert = " & Worksheets("Tabelle2").Cells(lngZANr, intS2).Value, , _
"Gefunden: " & Worksheets("Tabelle2").Cells(lngZANr, intS2).Address
'Inhalt in Tabelle1 übertragen
Worksheets("Tabelle1").Cells(lngZ1, 4) = Worksheets("Tabelle2").Cells(lngZANr, intS2).Value
intS2 = 257
Else
intS2 = intS2 + 1
End If
Loop Until intS2 > 256
End If
End If
End With
End If
Next lngZ1

End Sub

VBA-Editor öffnen, diesen Code in ein Modul kopieren (Modul ggf. vorher erstellen durch Rechtsklick auf VBAProjekt (Dateiname.xlsx) - Einfügen - Modul), Makro starten (über ALT + F8). Alles klar?

MfG
Klaus

Answer 2

Hallo noch einmal,

ich bin da auf ein Problem gestoßen und habe nicht den Hauch einer Ahnung, woran das liegen könnte. Ausgehend von Tabelle1 werden nacheinander die Artikelnummern 14101, 14000, 13912, 14419, 14308, 15086, 15951, ... bearbeitet. Bis zur 15086 (= 7. Zeile) einschließlich funktioniert alles wie gewünscht (zuletzt wird in Tabelle2!D13 der Wert 'FH' gefunden), aber für die 15951 findet der Suchbefehl plötzlich und ohne jeden ersichtlichen Grund nichts mehr - jedenfalls bei mir.

Konkret, nach

With Worksheets("Tabelle2").Range("A1:A" & Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1)
Set rngSuche2 = .Find(strANr, LookIn:=xlValues)

ist das rngSuche2-Objekt Nothing, obwohl alle vorigen Variablen und Objekte in Ordnung sind.

Allerdings musste ich die ursprüngliche XLSX-Datei in eine XLS-Datei umwandeln, da ich nur Excel 2003 habe.

Ich habe jede Menge kleine Veränderungen und Vereinfachungen im Code vorgenommen, variable Werte und Bereiche durch feste ersetzt usw., auch die Fixierung habe ich mal probeweise aufgehoben, hat aber alles nichts geholfen.

Bis ich dann in Tabelle2 oberhalb von Zeile 1 eine leere Zeile eingefügt und damit alles um 1 nach unten verschoben habe, dann ging es plötzlich fehlerfrei. Nun würde mich interessieren, ob irgend jemand dazu etwas sagen kann, den Fehler bestätigen kann, weiß woran es liegen könnte oder so. Die Frage ist, warum der Code in Antwort11 die Artikelnummer 15951 in der (verbundenen (?) und fixierten(?)) Zelle Tabelle2!A1 nicht findet.

Natürliche versuche ich, ausschließlich fehlerfreien Code anzubieten bzw. Fehlerkorrekturen nachzureichen, wenn nötig, aber hier weiß ich nicht weiter. Vielleicht ist eine Klärung innerhalb dieses Threads möglich oder soll ich deswegen einen neuen aufmachen?

MfG
Klaus

Answer 3

Hallo allerseits,

habe eine neue leere XLS-Datei erstellt, Werte neu eingegeben (Inhalte einfügen - Werte), Zellen gefärbt, Makro kopiert - und es funktioniert. Keine Ahnung, was da wo und wie kaputt gegangen ist.

Eventuell könnte man noch
Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row
durch
Worksheets("Tabelle2").UsedRange.SpecialCells(xlCellTypeLastCell).Row
ersetzen, wenn Leerzellen vorkommen.

Ansonsten ist die Sache damit für mich erledigt, schönen Abend noch!

Klaus

Answer 4

Sorry, Sorry,

habe jetzt erst mitbekommen, dass Ihr mir ganz tolle Makros geschrieben habt. Erstmal vielen, vielen Dank dafür. Ich werde sie natürlich ausprobieren und mich dann wieder melden.
Komischer Weise habe ich keine Mail mehr von Supportnet erhalten, dass weiter Antworten auf meine Frage eingenangen sind.

Nochmals vielen Dank

tacker914

Answer 5

Hallo,

also ich muss sagen, Ihr beide habt mir einen Bärendienst erwiesen. Nochmals vielen Dank dafür. Mit Euren Lösungen habt Ihr genau das abgebildet, was ich mir gewünscht habe.

@Klaus2 bei mir ist der gleiche Fehler wie bei Dir aufgetreten. Für den Artikel 15951 wurde nichts mehr gefunden.

@coros vielleicht könntest Du mal einen kurzen Blick über den Klaus2 sein Makro werfen.

So jetzt kann ich mein Problem als gelöst markieren und das Buch "VBA-Programmierung für Dummies" auf Seite legen. ;-)


Danke

Schöne Grüße

tacker914

Answer 6

Hallo tacker,

warum soll ich einen Blick auf Klaus sein Makro werfen. Mein Makro funktioniert und das ist doch das, was Du wolltest. Hättest Du es getestet, würdest Du sehen, dass auch für die Nummer 15951 das Richtige gefunden wird.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 7

Hallo coros,

schon klar, ich habe auch Dein Makro im Einsatz. Ich dachte nur in Klaus2 Interesse, weil er darum gebeten hat, ob ihm bei diesem Fehler jemand helfen könnte.

tacker914

Answer 8

Hallo tacker,

sorry, nochmal für mich zum Verständnis: Du benutzt beide Makros um zu Deinem Ziel zu kommen? Warum machst Du das, bzw. wozu ist das gut? Oder habe ich da etwas falsch verstanden?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 9

Hallo coros,

ich glaube da hast Du wirklich etwas falsch verstanden. Ich benutze nur ein Makro.

Gruß

tacker914

Answer 10

Hallo tacker,

sorry, dass ich nochmal nachfrage, aber welcher Code ist denn nun bei Dir im Einsatz? Denn für mich hörte sich das so an, dass der von Klaus bei Dir im Einsatz ist, aber auch laut Deiner Aussage

schon klar, ich habe auch Dein Makro im Einsatz

der von mir.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]