Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

If *.ColorIndex=1 Then ... If *.ColorIndex=2 Then





Frage

Hallo zusammen! Folgendes hab ich vor: abhängig von der Zellfarbe soll ein Button entweder die Zeile einfärben, kopieren und in eine zweite Tabelle einfügen oder entfärben und aus der zweiten Tabelle löschen. Das kopieren und löschen klappt auch soweit (Im vorigen Thread einen Code serviert bekommen). Was mir jetzt fehlt: Wie gebe ich diese Abfrage ein? Habe es wie folgt versucht: [i] If Range("B5").ColorIndex = xlNone Then [/i] da meckert er aber er erwarte ein Objekt. Der gesamte Code steht unten... Gruß & Danke vorab, nerwoest [i] Private Sub select_zeile_5_Click() Application.ScreenUpdating = False If Range("B5").ColorIndex = xlNone Then Range("B5:E5").Select Call einfaerben Range("B5:F5").Copy erste_leere_Zeile = Worksheets("Tabelle2"). _ Range("B65536").End(xlUp).Offset(1, 0).Row Worksheets("Tabelle2").Cells(erste_leere_Zeile, 1). _ PasteSpecial Paste:=xlValues Worksheets("Tabelle2").Cells(erste_leere_Zeile, 256) = "#1" End If If Range("B5").ColorIndex = 37 Then Range("B5:E5").Select Call clean_farbe erste_leere_Zeile = Worksheets("Tabelle2"). _ Range("B65536").End(xlUp).Offset(1, 0).Row For Wiederholungen = 1 To erste_leere_Zeile If Worksheets("Tabelle2").Cells(Wiederholungen, 256) = "#1" Then Worksheets("Tabelle2").Rows(Wiederholungen).Delete End If Next End If End Sub [/i]

Antwort 1 von Annan

Hallo,

du musst den ColorIndex näher definieren.
D.h. entweder frägst du die Zellfarbe oder die Schriftfarbe ab:

Zellfarbe abfragen:
If Range("B5").Interior.ColorIndex = xlNone Then

Schriftfarbe abfragen:
If Range("B5").Font.ColorIndex = xlNone Then

Das gleiche gilt auch für diese Abfrage:
If Range("B5").ColorIndex = 37 Then

MfG

Antwort 2 von nerwoest

Super - Danke Annan für die schnelle Antwort.

So funktionierts. Ich hab noch nie was mit VBA zu tun gehabt, deswegen hab ich mir diese unvollständigen Codes aus erstellten Makros o.ä. rausgelesen und rumprobiert.

Naja, jetzt läufts so wie ich wollte :-)

Vielen Dank nochmals ... cheffe wird sich freuen.

_______________________
Ich hab es jetzt so gelöst (für alle "nerwoest-einen-Code-ersteller" und evntl interessierte Mitleser):

Private Sub button_5_Click()
Application.ScreenUpdating = False

Range("B5:E5").Select
If Selection.Interior.ColorIndex = xlNone Then

Selection.Interior.ColorIndex = 37

Range("B5:F5").Copy
erste_leere_Zeile = Worksheets("Tabelle2"). _
Range("B65536").End(xlUp).Offset(1, 0).Row
Worksheets("Tabelle2").Cells(erste_leere_Zeile, 1). _
PasteSpecial Paste:=xlValues
Worksheets("Tabelle2").Cells(erste_leere_Zeile, 256) = "#1"


Else:

Selection.Interior.ColorIndex = xlNone

erste_leere_Zeile = Worksheets("Tabelle2"). _
Range("B65536").End(xlUp).Offset(1, 0).Row
For Wiederholungen = 1 To erste_leere_Zeile
If Worksheets("Tabelle2").Cells(Wiederholungen, 256) = "#1" Then
Worksheets("Tabelle2").Rows(Wiederholungen).Delete
End If

Next
End If

Range("B1").Select


End Sub

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: