Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten in Tabelle vergleichen und Textformat übertr

Daten in Tabelle vergleichen und Textformat übertr
20.12.2018 23:53:20
Peterle
Hallo ich habe folgendes Problem:
In einer Tabelle stehen in den Zellen N3 bis W 100 verschiedene Werte wie: A 01 b, C 10 a, J 05 d etc.
Diese Werte sind in 4 unterschiedlichen Farben eingetragen
(ColorIndex = 1 für Schwarz, 43 für Grün etc.)
In der Zeile darüber (N2 bis W2) sind Überschriften von A (Spalte N) bis J (Spalte W9) eingetragen.
Mein Problem ist nun, dass ich in die Zellen J18 bis J29 (12 Zellen) nacheinander Werte eintrage.
Ein Makro soll nun prüfen, ob diese neu eingetragenen Werte bereits in dem Bereich N3:W100 vorhanden sind und wenn Ja
soll die Textfarbe des gefundenen Wertes in den neu eingetragenen Wert, der dann einem bereits vorhandenen Wert entspricht, übernommen werden.
Beispiel: ich trage in die Zelle J18 den Wert A 03 d ein. Dieser Wert ist in Zelle Q7 in der Farbe grün (43) enthalten. Dann soll der Wert in Zelle J18 auch diesen Farbwert erhalten. Wenn dieser Wert in der Tabelle nicht enthalten ist, soll keine Reaktion stattfinden.
Anzumerken ist noch, dass nicht alle Zellen im Bereich N3:W100 belegt sind.
Vielleicht kann mir ja Jemand eine Lösung vorschlagen.
Dafür schon im voraus vielen Dank!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten in Tabelle vergleichen und Textformat übertr
21.12.2018 06:30:44
Sepp
Hallo Peter,
in das Modul der Tabelle. (ungetestet!)
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
  Dim rng As Range, rngSearch As Range 
 
  If Not Intersect(Target, Range("J18:J29")) Is Nothing Then 
    For Each rng In Intersect(Target, Range("J18:J29")) 
      If Len(rng) Then 
        Set rngSearch = Range("N3:W100").Find(What:=rng, LookIn:=xlValues, _
          LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 
        If Not rngSearch Is Nothing Then 
          rng.fornt.ColorIndex = rngSearch.Font.ColorIndex 
        Else 
          rng.Font.ColorIndex = xlAutomatic 
        End If 
      End If 
    Next 
  End If 
   
  Set rng = Nothing 
  Set rngSearch = Nothing 
End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige
Schreibfehler entdeckt!
21.12.2018 06:33:43
Sepp
Hallo nochmal,
da wahr ein Tipfehler im Code.
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
  Dim rng As Range, rngSearch As Range 
 
  If Not Intersect(Target, Range("J18:J29")) Is Nothing Then 
    For Each rng In Intersect(Target, Range("J18:J29")) 
      If Len(rng) Then 
        Set rngSearch = Range("N3:W100").Find(What:=rng, LookIn:=xlValues, _
          LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 
        If Not rngSearch Is Nothing Then 
          rng.Font.ColorIndex = rngSearch.Font.ColorIndex 
        Else 
          rng.Font.ColorIndex = xlAutomatic 
        End If 
      End If 
    Next 
  End If 
   
  Set rng = Nothing 
  Set rngSearch = Nothing 
End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0


 ABCDEF
1Gruß Sepp
2
3

Anzeige

310 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige