Microsoft Excel

Herbers Excel/VBA-Archiv

Wenn Farbe im Zellbereich, Dann... | Herbers Excel-Forum


Betrifft: Wenn Farbe im Zellbereich, Dann... von: Matthias
Geschrieben am: 09.01.2012 16:21:12

Hallo @ All ,...
der Matze braucht mal wieder Hilfe.

Sind gleich 2 Bedingungen:

Wenn im Bereich A57:A74 Der Inhalt "XXX" erscheint, dann aus Zeile F54:AJ54 nur die 'grün = 5296274 Color herrauslesen und in den Füllbereich F57:AJ74 ein "F" übertragen, die anderen Farben ignorieren.

Wenn im Bereich A79:A96 Der Inhalt "XXX" erscheint, dann aus Zeile F76:AJ76 nur die 'blau = 15773696 Color herrauslesen und in den Füllbereich F57:AJ74 ein "" übertragen, die anderen Farben ignorieren.

MfG Matthias

  

Betrifft: wenn blau ... wenn grün ... dann "F" oder """" von: Matthias L
Geschrieben am: 09.01.2012 17:01:19

Hallo Matze

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x&
'grün
 If Not Intersect(Target, Range("A57:A74")) Is Nothing And Target.Count = 1 Then
  For x = 6 To 36
   If Target.Value = "XXX" Then
      If Cells(54, x).Interior.Color = 5296274 Then Cells(Target.Row, x).Value = "F"
   Else
      Cells(Target.Row, x).Value = ""
   End If
  Next
 End If
'blau
 If Not Intersect(Target, Range("A79:A96")) Is Nothing And Target.Count = 1 Then
  For x = 6 To 36
   If Target.Value = "XXX" Then
      If Cells(76, x).Interior.Color = 15773696 Then Cells(Target.Row, x).Value = ""
   Else
     Cells(Target.Row, x).Value = "x"
   End If
  Next
 End If
End Sub
https://www.herber.de/bbs/user/78323.xls

Gruß Matthias


  

Betrifft: @Matthias L. ....bin zwar noch.... von: Matthias
Geschrieben am: 09.01.2012 17:19:33

am testen, sieht soweit auch schon gut aus bis auf den Blau defenierten Bereich:

Else
Cells(Target.Row, x).Value = "x"

Die "alten Werte" werden nun von "x" überschrieben , das darf nicht sein!

Matze


  

Betrifft: ich weiß ... von: Matthias L
Geschrieben am: 09.01.2012 17:23:39

Hallo Matze

... aber ich mußte ja testen, ob die Zellen auch im Else-Zweig angesprochen werden

Einfach die Zeile:
Cells(Target.Row, x).Value = "x" auskommentieren

also
'Cells(Target.Row, x).Value = "x"

Gruß Matthias


  

Betrifft: @Matthias L. OK muss anders formulieren,... von: Matthias
Geschrieben am: 09.01.2012 17:52:38

es überschneiden sich hier mehere makros, es werden in den füllbereich vorher Werte eingelesen.
bitte das "neue" Makro in einem Modul aufbauen.

Modul1 - blau
'blau
If Not Intersect(Target, Range("A79:A96")) Is Nothing And Target.Count = 1 Then
For x = 6 To 36
If Target.Value = "XXX" Then
If Cells(76, x).Interior.Color = 15773696 Then Cells(Target.Row, x).ClearContents LÖSCHEN
Else
'Cells(Target.Row, x).Value = "" alte Werte müssen stehen bleiben !!
End If
Next
End If

Modul2 - Grün
'grün
If Not Intersect(Target, Range("A57:A74")) Is Nothing And Target.Count = 1 Then
For x = 6 To 36
If Target.Value = "XXX" Then
If Cells(54, x).Interior.Color = 5296274 Then Cells(Target.Row, x).Value = "F" 'OK
Else
Cells(Target.Row, x).clearcontents 'LÖSCHEN
End If
Next
End If


Matze


  

Betrifft: Code gehört in die Tabelle! nicht in ein Modul oT von: Matthias L
Geschrieben am: 09.01.2012 18:03:45