Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon _heike_ vom 13.12.2019, 15:46 Options

Bedingte Formatierung mit VBA

Hallo Ihr Lieben,

ich brauche etwas Hilfe.
Ich benötige mehr als 3 bed. Formatierungen. Ich hab auch schon Code dazu gefunden, mir fehlen jetzt nur ein paar Randbedingungen die ich mit der "normalen" Bedingten Formatierung kein Problem waren.

Bis jetzt hab ich folgendes:


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
    Dim Bereich As Range 
    Dim rngZelle As Range 
    Set Bereich = ActiveSheet.Range("1:1") 
        
    For Each rngZelle In Bereich 
        Select Case rngZelle 
            Case "1" 
                rngZelle.Interior.Color = RGB(255, 0, 0) 
            Case "2" 
                rngZelle.Interior.Color = RGB(0, 255, 0) 
            Case "3" 
                rngZelle.Interior.Color = RGB(0, 0, 255) 
            Case "4" 
                rngZelle.Interior.Color = RGB(255, 255, 0) 
            Case "5" 
                rngZelle.Interior.Color = RGB(0, 255, 255) 
            Case "test" 
                rngZelle.Interior.Color = RGB(0, 255, 255) 
            Case Else 
                rngZelle.Interior.ColorIndex = xlNone 
        End Select 
    Next 
End Sub

Es wird also die 1. Zeile formatiert. Wenn ich jetzt aber darüber noch eine Zeile einfüge, geht das ja nicht mehr... wie bekomm ich sowas hin?

Außerdem möchte ich dass die Zelle direkt darunter in der gleichen Farbe eingefärbt wir - steh aber irgendwie aufm Schlauch

Vielen Dank für Eure Hilfe
Gruß
_heike_

Antwort schreiben

Antwort 1 von Beverly vom 14.12.2019, 06:08 Options

Hi Heike,

vergib für die Zelle einen Namen, z.B. Zelle1

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address <> Range("Zelle1").Address Then Exit Sub
    Select Case Target
        Case "1"
            Target.Interior.Color = RGB(255, 0, 0)
            Target.Offset(1, 0).Interior.Color = RGB(255, 0, 0)
        Case "2"
            Target.Interior.Color = RGB(0, 255, 0)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 0)
        Case "3"
            Target.Interior.Color = RGB(0, 0, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 0, 255)
        Case "4"
            Target.Interior.Color = RGB(255, 255, 0)
            Target.Offset(1, 0).Interior.Color = RGB(255, 255, 0)
        Case "5"
            Target.Interior.Color = RGB(0, 255, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 255)
        Case "test"
            Target.Interior.Color = RGB(0, 255, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 255)
        Case Else
            Target.Interior.ColorIndex = xlNone
            Target.Offset(1, 0).Interior.Color = xlNone
    End Select
End Sub

Bis später,
Karin

Antwort 2 von _heike_ vom 14.12.2019, 10:08 Options

Hallo Karin,

vielen Dank für Deine Antwort.
Leider hab ich nicht verstanden, was die erste Zeile (If Target.Address <> Range("Zelle1").Address Then Exit Sub) genau macht.

Aber der Hinweis, dass ich einen Namen vergeben soll, hat schon gereicht. Statt ("1:1") hab ich jetzt einfach den Namen angegeben.
Und für die Zeile darunter einfärben hast Du genau die Lösung geliefert, die ich gebraucht habe.

Vielen Dank
und euch allen ein schönen We

Gruß
_heike_

Antwort 3 von Hajo_Zi vom 14.12.2019, 10:12 Options

aHallo Heike,

das ist nur der Vergleich ob die Addresse der geänderten Zelle(n) mit der Zelleadresse von Deinen benannten Zelle übereinstimmt, falls ncht Exit Sub Procedur verlassen.

Gruß Hajo

Antwort 4 von _heike_ vom 14.12.2019, 11:01 Options

Danke für die Antwort.

Jetzt habs auch ich verstanden.
Dann bau ich das bei mir auch noch ein.

Gruß
Heike

Antwort 5 von _heike_ vom 14.12.2019, 13:05 Options

Hilfe!!!

Ich hab etwas herumprobiert. Die Formatierung für mehrere Tabellenblätter definier, Teile von mir auskommentiert und die neue Zeile eingefügt....

Jetzt stürzt mir Excel ab.
Aber nur beim editieren des Codes für ein Tabellenblatt.

Sobald ich eine Zeile mit
Dim Bereich As Range schreibe reagiert Excel nicht mehr und ich muss es schließen.

Was hab ich falsch gemacht??

Gruß
Heike

Antwort 6 von _heike_ vom 14.12.2019, 13:32 Options

So, ich hab gleich noch ne Frage.

Wenn ich die Variante von Karin benutze, funktioniert das ja nur, wenn ich als Bereich eine Zelle habe...

Ich brauch aber einen größeren Bereich mit ca. 20 Spalten.
Den Namen kann ich ja auch für den Bereich angeben, was muss ich dann im Code ändern?

Danke schonmal

Gruß
Heike

Antwort 7 von Beverly vom 14.12.2019, 15:37 Options

Hi Heike,

was du falsch gemacht hast, kannst nur du wissen, da nur du den jetzigen Code kennst.

Wie viele Zellen der mit einem Bereichsnamen festgelegte Bereich umfasst oder wie er heißt ist gleichgültig.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Intersect(Target, Range("MeinBereich")) Is Nothing Then Exit Sub
    Select Case Target
        Case "1"
            Target.Interior.Color = RGB(255, 0, 0)
            Target.Offset(1, 0).Interior.Color = RGB(255, 0, 0)
        Case "2"
            Target.Interior.Color = RGB(0, 255, 0)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 0)
        Case "3"
            Target.Interior.Color = RGB(0, 0, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 0, 255)
        Case "4"
            Target.Interior.Color = RGB(255, 255, 0)
            Target.Offset(1, 0).Interior.Color = RGB(255, 255, 0)
        Case "5"
            Target.Interior.Color = RGB(0, 255, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 255)
        Case "test"
            Target.Interior.Color = RGB(0, 255, 255)
            Target.Offset(1, 0).Interior.Color = RGB(0, 255, 255)
        Case Else
            Target.Interior.ColorIndex = xlNone
            Target.Offset(1, 0).Interior.Color = xlNone
    End Select
End Sub

Bis später,
Karin

Antwort 8 von _heike_ vom 14.12.2019, 16:41 Options

Vielen Dank Karin,

ich war schonfast am Verzeifeln ;-)
Nachdem ich das Tabellenbaltt gelöscht habe und den gleichen Code in ein neues Blatt wieder eingefügt habe ging wieder alles...

Danke für Deine Lösung, die funktioniert super!

Wünsch Dir ein schönes We

Gruß
Heike

Antwort 9 von _heike_ vom 17.12.2019, 16:39 Options

So, ich hab nochmal ne kleine Frage ;-)
(irgendwie wirft jede Anwort eine neue Frage auf)

Ich schreibe die Werte nicht direkt in die Zellen, sondern wähle sie durch ein Dropdownmenü aus.

Wenn ich den Wert änder, muss ich dann erst eine andere Zelle anclicken, dann wieder die Zelle in der ich den Wert geändert habe, und dann ändert sich erst die Farbe.
An was liegt das?

Außerdem funktioniert es mit:


Private Sub Worksheet_Change(ByVal Target As Excel.Range)

gar nicht, nur mit:


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Gruß
Heike

Antwort 10 von Hajo_Zi vom 17.12.2019, 16:48 Options

Hallo Heike,

das Change Ereignis reagiert nur auf Zellveränderung. Für Formel musst Du das Private Sub Worksheet_Calculate() benutzen. Ein Beispiel findest Du auf meiner Homepage.
Link zur Datei

Gruß Hajo

Antwort 11 von Beverly vom 17.12.2019, 16:54 Options

Hi Heike,

schreibe in eine Zelle z.B. =ZUFALLSZAHL() und verwende das Calculate -Ereignis

Bis später,
Karin

Antwort 12 von _heike_ vom 17.12.2019, 17:14 Options

Danke euch Beiden,

funktioniert prima!

Gruß
Heike

Antwort 13 von _heike_ vom 17.12.2019, 18:13 Options

Hallo Ihr,
das hat jetzt ja alles viel zu schön funktioniert...

Die Daten für das Dropdownmenü kommen aus ner 2. Excel Mappe. Ich haben dann einen Button eigebaut, über den man die Listen aktuallisieren kann (der Bereich wird neu eingelesen und definiert).

Wenn ich den Button jetzt betätige, kommt der Laufzeitfehler '1004':
Die Color-Eigenschaft des Interior-Objekts kann nicht festgelegt werden.

Wird das Button clicken als Event für "Worksheet_Calculate" hergenommen?
Kann ich das umgehen?

Gruß
Heike

Antwort 14 von Beverly vom 17.12.2019, 18:22 Options

Hi Heike,

das Klicken auf den Button nicht, aber jede Veränderung in der Tabelle, die evtl durch den Button ausgelöst wird.
Du kannst höchstens die Zelle mit dem DropDown-Listenfeld mittels WorksheetChange überwachen, dann sollte es eigentlich auch funktionieren.

Bis später,
Karin

Antwort 15 von _heike_ vom 17.12.2019, 18:30 Options

Hallo Katrin,

ich werds morgen gleich mal versuchen.
Aber im Prinzip läuft das dann wieder auf die vorherige Lösung hinaus, bei der die Farbänderung erst nach dem clicken in eine andere Zelle und dann wieder in die Geänderte erfolgt.

Vielen Dank

Gruß
Heike

Antwort 16 von Beverly vom 17.12.2019, 18:35 Options

Hi Heike,

ich kenne leider deine Arbeitsmappe nicht. Ich habe jetzt ein Beispiel erstellt, bei dem mittels Change (nicht SelectionChange !!) der Code ausgelöst wird, sobald in der Zelle mit dem DropDown-Listenfeld ein anderer Eintrag gewählt wird. Mein Code dazu lautet so

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$11" Then
        MsgBox Range("D11")
    End If
End Sub

In Zelle D11 befindet sich das DropDown-Listenfeld.

Bis später,
Karin

Antwort 17 von _heike_ vom 18.12.2019, 09:50 Options

Hallo Karin,

irgendwie bekomm ich die Lösung nicht hin.
Wie kann ich den hier ne Datei veröffentlichen?
Wär einfacher, wenn ihr meine letzte (einigermaßen) funktionierende Version kennt.

Gruß
Heike

Antwort 18 von aiuto vom 18.12.2019, 09:55 Options

Hallo Heike,

Lade Deine Datei bei www.netupload.de hoch und poste den Link dazu hier im Thread.

mfg
vom Helfer

Antwort 19 von _heike_ vom 18.12.2019, 10:03 Options

Danke,

hier mal ein Link zu der Bsp. Datei.

http://www.netupload.de/detail.php?img=5c65a762c14d6078cea7c12b91...

Gruß
Heike

Antwort 20 von _heike_ vom 18.12.2019, 10:12 Options

Der Link geht nicht:
hier nochmal:
http://www.netupload.de/detail.php?img=5c65a762c14d6078cea7c12b9104f901.xls

Gruß
Heike

« Zurück
1
2
Weiter »

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken