Clever-Excel-Forum

Hallo liebe User,

ich brauche einen VBA code der folgendermaßen wirken soll:

In der Spalte H sollen alle Zellen, die sich in den Bereichen H4:H102, H109:H207 und H215:313 befinden UND ROT ausgefüllt sind, auf Änderungen überwacht werden um dann jeweils bei JEDER änderung ein Makro zu starten.

Das Ganze soll dann so gelebt werden:

Ich SELBST fülle pro Bereich 2- 4 Zellen, sind jeden Tag andere, durch Doppelklick rot (farbindex 3) aus und diese sind dann aufgrund ihrer roten Füllung in der überwachung.

Bisher hab ich die Zellpositionen immer händisch in den entsprechenden Worksheet eingetragen.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Not [xlEIN] Then Exit Sub

If Target.Cells.Count > 1 Then Exit Sub

'-- wenn flg true ist, Vorgang abrechen

    If flg Then flg = False: Exit Sub

'-- Spalte [spScanner] auswerten

    If Target.Column = [spScanner] Then Call GefundenenWert_Select(Target.Value)

'-- Spalte [spAnzahl] auswerten

    If Target.Column = [spAnzahl] Then Call GeheInZelle(Target.Row, [spScanner])

 '############################## Prüfalarm  #########################

    If Intersect(Target, Range("H7,H99,H112,H204,H218,H310")) Is Nothing Then Exit Sub

    Call MakroXYZ

  '#################################################################

End Sub

Am besten würde es mir gefallen wenn der VBA code nur einfach die Werte bei Range, analog der roten Zellen, im vorhandenden Sub Change ändert.

Wenn mir da jemand etwas liefern könnte, wäre ich sehr dankbar.

Grüße
zwoo

Hallo,

warum nicht einfach eine weitere Prüfung auf

Code:
if Target.interior.color <> vbred then exit sub

mfg

Danke für die schnelle Antwort.

Code:
If Intersect(Target, Range("H4:H102,H109:H207,H215:313")) Is Nothing Then Exit Sub

    Call MakroXYZ

if Target.interior.color <> vbred then exit sub

End Sub

Meinst Du so? Ich teste das mal eben.

Es war so einfach, dass ich es nicht gleich hinbekommen habe.

Danke Fennek, dass ist exakt das was ich wollte! Mein Tag ist gerettet. :78:

LG
zwoo

Hallo,

eine kleine Sache wäre da noch.

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

      With Selection.Interior

         .ColorIndex = 3

         .Pattern = xlSolid

      End With

   End Sub

Wie bekomme ich es hier hin, dass es nur in den Spalten H bis M zu der gewünschten einfärbung führt und nicht auf dem gesamten Blatt?

LG
zwoo

Hallo,

"Selction" ist mir zu unkontrolliert. Versuche es mal so (ungeprüft)

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

if  intersect(Target, columns("H:M")) is nothing then exit sub  

With Target.Interior

        .ColorIndex = 3

        .Pattern = xlSolid

     End With

  End Sub

mfg

Hallo Fennek,

auch diese Lösung funktioniert tadellos!

Vielen lieben Dank.

LG
zwoo

zwoologe

Fennek

zwoologe

zwoologe

zwoologe

Fennek

zwoologe