Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1640to1644
1640to1644
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bei farbiger Zelle einen Zellbereich übertragen

Forumthread: Bei farbiger Zelle einen Zellbereich übertragen

Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 12:26:54
Felix
Hallo zusammen,
der folgende Code sucht im Tabellenblatt "Abgleich" nach einer Zelle mit dem Farbcode (gelb) und soll anschließend die zur Zelle gehörige Zeile im Spaltenbereich A-H auf das Tabellenblatt "Output" kopieren. Dies soll für alle Zellen im Bereich A1:H100 im Tabellenblatt "Abgleich" passieren.
Leider wirft mir der Code keine Ergebnisse aus, obwohl entsprechende farbige Zellen existieren.
Kann mir jemand helfen?
Dim lz As Long
Dim zel As Range
lz = Sheets("Output").Range("A65000").End(xlUp).Row
For Each zel In Sheets("Abgleich").UsedRange.Columns(6)
If zel.DisplayFormat.Interior.ColorIndex = 65535 Then
Sheets("Output").Range("A" & lz + 1).Resize(1, 8) = Sheets("Abgleich").Range("A" & zel.Row & ":H" & zel.Row).Resize(1, 8).Value
lz = lz + 1
End If
Next zel
Vielen Dank
VG
Felix
Anzeige

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 12:30:57
Rudi
Hallo,
ColorIndex 65535 gibt es nicht.
.Color = 65535
Gruß
Rudi
AW: Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 12:43:54
Felix
Hallo Rudi,
Vielen Dank, CopyPaste-Fehler.
Leider funktioniert der Befehl immer noch nicht...
VG
Felix
Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 13:19:37
Rudi
If zel.Interior.Color = 65535 Then
Und prüfe, ob die Zellen wirklich RGB(255,255,0) haben.
Anzeige
AW: Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 13:48:25
Felix
Hallo,
danke kannst du mir den RGB-Fehler eventuell sagen, da bin ich leider schwach.
Vielen Dank
'Vergleich Geschäfte und TR-Pool
Dim GeschNr As Range ' Variable Bereich 2
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("Abgleich")
' 1. Schleife alle Zellen Bereich2
For Each GeschNr In .Range("P2:P100")
If Application.CountIf(.Range("F2:F100"), GeschNr) _
= 0 And GeschNr "" Then GeschNr.Interior.Color = RGB(255, 255, 0)
Next GeschNr
' 1. Schleife alle Zellen Bereich1
For Each GeschNr In .Range("F2:F100") ' 1. Schleife alle Zellen Bereich2
If Application.CountIf(.Range("P2:P100"), GeschNr) _
= 0 And GeschNr "" Then GeschNr.Interior.Color = RGB(255, 255, 0)
Next GeschNr
End With
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
'Bei Abweichungen zwischen Geschäftsnummern wird der jeweilige Bereich farbig markiert und in das Blatt "Output" kopiert
'Bereich1
Dim lz As Long
Dim zel As Range
lz = Sheets("Output").Range("A65000").End(xlUp).Row
For Each zel In Sheets("Abgleich").UsedRange.Columns(6)
If zel.Interior.Color = 65535 Then
Sheets("Output").Range("A" & lz + 1).Resize(1, 8) = Sheets("Abgleich").Range("A" & zel.Row & ":J" & zel.Row).Resize(1, 8).Value
lz = lz + 1
End If
Next zel
VG
Anzeige
DisplayFormat => Bedingte Formatierung?
03.09.2018 14:00:45
Daniel
Hi
im Code der Eingangsfrage steht "DisplayFormat.Interior.Color"
wird die gesuchte Farbe durch Bedingte Formatierung erzeugt?
wenn ja, musst du bei "DisplayFormat" bleiben, ansonsten fragst du nur die Farbe der normalen Zellformatierung ab.
Gruß Daniel
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 14:16:42
Felix
Hallo Daniel,
nein, es liegt keine bedingte Formatierung vor, die Farbe wird über den VBA-Code erzeugt, ich weiß nur leider nicht warum der Befehl nicht ausgeführt wird, scheint am Farbcode zuliegen.
VG
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 14:31:30
Daniel
Hi
Hast du dir schon mal den Farbcode einer Zelle, die übertragen werden soll, anzeigen lassen?
hierzu einfach eine Zelle, die übertragen werden muss anklicken und dir den Farbwert im Direktfenster mit
?Selection.Interior.Color
oder
?Selection.Interior.colorindex
anzeigen lassen.
den angezeigten Wert übernimmst du dann in deinen Code.
Colorindex ist zwar ein Überbleibsel aus den alten Excelversionen vor 2007, sollte aber auch funktionieren, sofern du nicht sehr ähnliche Farben im Blatt verwendest, die dann trotz unterschiedlichem RGB-Wert den gleichen Index erhalten.
Gruß Daniel
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 14:54:00
Felix
Hi,
ja das funktioniert habe jetzt auch als ColorIndex=4 ausgewählt, die Veränderung wurde sofort übernommen, es hängt scheinbar nur noch am zweiten Teil, sprich der Auswahl der farbigen Zellen samt Zellbereichen...
VG
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 15:01:33
daniel
HI
wo genau ist jetzt das Problem?
hier mal der Code für colorindex 4, vorausgesetzt dass in Spalte A immer ein Wert steht. 
Dim zel As Range
For Each zel In Sheets("Abgleich").UsedRange.Columns(6)
If zel.Interior.ColorIndex = 4 Then
zel.offset(0, -5).Resize(1, 8).Copy
Sheets("Output").Cells(Rows.Count, 1).end(xlup).Offset(1, 0).pastespecial xlpastevalues
End If
Next zel
Gruß Daniel
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 15:15:53
Felix
Danke für deine Hilfe,
das Problem ist das keine Fehlermeldung erscheint, jedoch keine der farbigen Zellen (in Spalte F) in das Tabellenblatt "Output" kopiert wird, scheinbar führt der Befehl ins Leere, ich finde jedoch keinen Fehler...
VG
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 15:22:52
daniel
ich finde auch keinen.
kann ich auch nicht, da ich weder deinen Code, noch deine Datei kenne.
hast du schon mal in Abgleich die erste Zeile entsprechend umgfärbt und dann im Einzelstep getestest, um zu sehen was überhaupt im Code passiert?
Gruß Daniel
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 16:08:51
Felix
Hi Daniel,
danke für deine Geduld, diesen Testlauf habe ich ausprobiert, er führt das Kopieren nur für die erste Zeile aus, in der jedoch Überschriften stehen...
Scheinbar liegt dort der Fehler:
Mein kompletter Code: 
Sub Button()
'Sortieren der Geschäfte, Ausschluss von Geschäften der Art ,,AllgGebühr"
'Kopieren der Blätter "Geschäfte_anzeigen" und "TR-Pool" in Blatt "Abgleich"
Sheets("Geschäfte_anzeigen").Activate
Range("A1:I1").AutoFilter Field:=5, Criteria1:="AllgGebühr"
Sheets("TR-Pool").Activate
Range("A1:GB1").AutoFilter Field:=6, Criteria1:="Geschäfte"
Range("A1:GB1").AutoFilter Field:=15, Operator:=xlOr, Criteria1:="N", Criteria2:="C"
Sheets("Geschäfte_anzeigen").Range("A1:I100").Copy Sheets("Abgleich").Range("A1")
Sheets("TR-Pool").Range("F1:O100").Copy Sheets("Abgleich").Range("K1")
Sheets("Abgleich").Activate
'Vergleich Geschäfte und TR-Pool
Dim GeschNr As Range                           ' Variable Bereich 2
Application.ScreenUpdating = False              ' Bildschirmaktualisierung aus
With Worksheets("Abgleich")
' 1. Schleife alle Zellen Bereich2
For Each GeschNr In .Range("P2:P100")
If Application.CountIf(.Range("F2:F100"), GeschNr) _
= 0 And GeschNr  "" Then GeschNr.Interior.ColorIndex = 4
Next GeschNr
' 1. Schleife alle Zellen Bereich1
For Each GeschNr In .Range("F2:F100")      ' 1. Schleife alle Zellen Bereich2
If Application.CountIf(.Range("P2:P100"), GeschNr) _
= 0 And GeschNr  "" Then GeschNr.Interior.ColorIndex = 4
Next GeschNr
End With
Application.ScreenUpdating = True               ' Bildschirmaktualisierung ein
'Bei Abweichungen zwischen Geschäftsnummern wird der jeweilige Bereich farbig markiert und in  _
das Blatt "Output" kopiert
'Bereich1
Dim lz As Long
Dim zel As Range
lz = Sheets("Output").Range("A65000").End(xlUp).Row
For Each zel In Sheets("Abgleich").UsedRange.Columns(6)
If zel.Interior.ColorIndex = 4 Then
Sheets("Output").Range("A" & lz + 1).Resize(1, 8) = Sheets("Abgleich").Range("A" & zel. _
Row & ":J" & zel.Row).Resize(1, 8).Value
lz = lz + 1
End If
Next zel
End Sub
Danke
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 16:16:56
daniel
hi
und wie soll ich deinen Code testen?
btw erkläre uns bitte, warum erst die Spalten A-J (1-10) um sie dann wieder auf die Spalten A-H (Resize(1, 8)) zu reduzieren?
warum machst du dass bei den Quelldaten im Sheet Abgleich nicht genau so wie im Sheet Output?
Sheets("Output").Range("A" & lz + 1).Resize(1, 8) = Sheets("Abgleich").Range("A" & zel. _
Row & ":J" & zel.Row).Resize(1, 8).Value
Gruß Daniel
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 16:36:30
Felix
Hi Daniel,
ich müsste die Excel leider erst anonymisieren, schaff ich heute nicht mehr.
Um es mal prinzipiell zu sagen:
Ich hätte eigentlich nur im Sinn, dass wenn zB. die Zeile F2 den ColorIndex 4 hat, die Zeile 2 von A2:I2 kopiert wird und im Tabellenblatt "Output" eingefügt wird.
Und das ganze sollte dann im Bereich A2:I100 funktionieren.
Ich hoffe dir wird es jetzt klarer, denke es hängt nur an dem Code ab Bereich 1'.
Ich teile deine Meinung, dass das mit Resize keinen Sinn macht.
Danke dir!
VG
Felix
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 16:58:20
Daniel
Hi
das mit dem Resize ist schon sinnvoll.
dann brauchst du nur die Linke Zelle der zeile mit Cells anzugeben und dann mit Resize auf 8 Spalte zu erweitern.
ist wesentlich einfacher als dein kompliziertes Range-Gedöns.
Gruß Daniel
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 17:20:54
Felix
Hi,
kannst du mir sagen, wie du es dann schreiben würdest über Cells?
Wär dir sehr dankbar, komm gerade nicht weiter...
VG
Felix
Anzeige
AW: DisplayFormat => Bedingte Formatierung?
03.09.2018 17:41:18
Daniel
Hatte ich doch schon, lies die Beiträge.
gruß Daniel
AW: Bei farbiger Zelle einen Zellbereich übertragen
03.09.2018 13:44:59
Daniel
Hi
Filtere mit dem Autofilter nach der gesuchten Farbe und kopiere dann die Zellen.
In gefilterten Tabellen werden nur die Sichtbaren Zeilen kopiert.
Zeichne mit dem Recorder auf und passe den Code entsprechend an.
Gruß Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige