VBA soll Zahl ermitteln

Question

Hi Forum

Ich suche eine VBA Lösung die folgendes macht.

In Tabelle1 B2 steht eine Zahl z.b 9 diese ist Variable und ändert sich
ständig bei jedem Durchlauf.

In Tabelle 2 sind meine "Archiv Nummern" einige werden mit einem
Makro in .Interior.ColorIndex = 28 eingefärbt.

Jetzt soll nach .Interior.ColorIndex = 28 gesucht werden
wenn unterhalb der gesuchten Farbe
die Zahl aus der Tabelle 1 B2 zb 9 steht dann
kopiere die erste Zahl oberhalb von der Farbe in Tabelle 3

Läst sich das irgendwie machen wäre toll


mfg
Tim2017c

Answer 1

Hallo Tim2017c .-)

Funktioniert leider nicht der Filehoster!

Schick nochmal an mein Emailfach
Oberley@t-online.de

Gruss Nighty

Answer 2

Hallo Tim2017c .-)

Ich hab das mal auf RGB umgestellt!
Probier mal!
Ansonsten schick die Datei an meine Emailadresse!

Gruss Nighty

Farbindex 28 ist RGB=0, 255, 255 als Grundeinstellung
Bei bedarf anpassen

Sub Suchen()
Dim SuchZelle As Long
Dim QuellDat As Variant, SuchDat As Variant, ZielZelle As Variant
Worksheets(3).Cells.Clear
SuchDat = Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row)
Set QuellDat = Worksheets(2).Range(Worksheets(2).Cells(1, 1), Worksheets(2).Cells(Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row, Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Column))
For SuchZelle = 2 To UBound(SuchDat)
For Each ZielZelle In QuellDat
If QuellDat(ZielZelle.Row, ZielZelle.Column) = SuchDat(SuchZelle, 1) Then
If RGBwerteAddieren(Worksheets(2).Cells(ZielZelle.Row - 1, ZielZelle.Column), 0, 255, 255) = True Then
Worksheets(3).Cells(Worksheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = QuellDat(ZielZelle.Row - 2, ZielZelle.Column)
End If
End If
Next ZielZelle
Next SuchZelle
End Sub

Function RGBwerteAddieren(Zellen As Range, Rrgb As Integer, Grgb As Integer, Brgb As Integer) As Boolean
Dim Rot As Long, Grün As Long, Blau As Long, Wert As Long
Wert = Zellen.Interior.Color
Rot = Wert Mod 256
Wert = (Wert - Rot) / 256
Grün = Wert Mod 256
Wert = (Wert - Grün) / 256
Blau = Wert Mod 256
If Rrgb = Rot And Grgb = Grün And Brgb = Blau Then RGBwerteAddieren = True
End Function

Answer 3

Hi Nighty_

Passt Perfekt

Danke