Office: Zellen automatisch einfärben...

Hallo,

ich habe folgende Aufgabe zu lösen.
In der angefügten Datei gibt es zwei Tabellenblätter.
In Tabellenblatt 2 erhalten verschiedene Personen Zellkoordinaten eingetragen
(im Beispiel etwa Anton die Koordinate D3).
Nach dem Eintragen soll sich die angegebene Zelle automatisch färben.

Kann man das irgendwie über ein Makro regeln...?

Für jede Hilfe bin ich dankbar :)
tobi

 

Hallo tobstein,

angenommen die Zelle, in die die Zelladresse eingegeben werden soll sei die Zelle B1 sieht der Code so aus:

Sub tobstein()
Range(Range("B1").Value).Interior.ColorIndex = 45
End Sub

Dieses Code hinter das entsprechende Tabellenblatt und per Schaltfläche oder anderer Aktion aufrufen.

(Nur einbauen in deine Tabelle musst du es selbst)

Klappt?

Martin

 

Hallo MartinPe,

erst mal vielen Dank für Deine schnelle Hilfe.
Das mit dem Einbauen werde ich schon hinbekommen...aber

die Lösung schein mir ja nur eine Zelle abzudecken. Wahrscheinlich habe ich mich
auch nicht genau ausgedrückt.

In allen Zellen der Tabelle2 (von B1:=58) werden Koordinaten eingetragen und dementsprechend
sollen dann alle eingetragenen Zellwerte in Zabelle1 gefärbt werden.
ich hoffe, dies war so verständlich.

tobi

 

Hallo tobi,

richtig. Das war nur für eine Zelle, hatte ich so verstanden (hab mir deine Datei nicht angeguckt). Hier nun für den Bereich B1:B58, wobei ich jetzt festgelegt habe, dass die Farbe in der Spalte Q hinterlegt wird:

Sub tobstein()
For j = 1 To 58
For i = 2 To 15
Range(Cells(j, i).Value).Interior.ColorIndex = Cells(j, 17).Value
Next i
Next j
End Sub

Klappt?

Martin

 

Leider nicht...ich erhalte immer einen VBA-Fehler.
Text des Fehlers "400" ????

Und eine Frage noch. Müsste man in den Befehlen nicht anmerken, dass sich die zu färbenden Zellen in Tabelle1
befinden...?
tobi

 

Dann mach mal so:

Sub tobstein()
On Error GoTo Fehler
For j = 1 To 5
For i = 2 To 15
Sheets("Tabelle1").Range(Cells(j, i).Value).Interior.ColorIndex = Cells(j, 17).Value
Next i
Next j
Exit Sub
Fehler:
MsgBox "Fehler im Code" & vbCrLf & "Fehlernummer: " & Err.Number & _
vbCrLf & "Fehlerbeschreibung: " & Err.Description

End Sub

Was steht nun da?

Martin

PS: Dass es für Tabelle1 sein soll hatte ich übersehen, ist jetzt drin

 

Die Fehlernummer lautet nun 1004.
Anwendungs- oder objektdefinierter Fehler

 

Lad die Datei bitte mal hoch...

 

Bitte schön...:D

 

Dann gib mal Farbwerte (1-56) in Spalte Q ein (erwähnt in Antwort von 13:00), dann sollte es funktionieren. ;-)
Wenn du dann noch den Code so abänderst, springt der Code einfach raus wenn das erste Mal keine Farbe drin steht:

Sub tobstein()
On Error GoTo Fehler
For j = 1 To 5
For i = 2 To 15
Sheets("Tabelle1").Range(Cells(j, i).Value).Interior.ColorIndex = Cells(j, 17).Value
Next i
Next j
Exit Sub
Fehler:
Exit Sub
End Sub

Klappts?

Martin

 

Hallo Martin,

sorry dass ich mich erst jetzt melde, aber gestern kam ich nicht mehr dazu.

Jetzt klappt's perfekt :D

Das mit der Spalte Q hatte ich tatsächlich überlesen...

Danke
tobi

 

Macht ja nix.

Schön, dass Du eine Rückmeldung gegeben hast!

 

Hallo Tobi,

wenn Du im VisualBasicEditor in dem entsprechenden VBAProjekt (Formular1) die Tabelle2 doppelklickst, öffnet sich ein leeres Fenster, falls noch keine Makros zu dem Sheet eingestellt sind.
Das Fenster hat als Überschrift zwei Listboxen, bei denen Du in der linken den Begriff "Worksheet" und bei der rechten den Begriff "Change" auswählen musst.
Dort fügst Du folgendes Coding ein:

Option Explicit

Dim Inhalt As String
Dim Spalte As Byte
Dim Zeile As Byte

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 Then Exit Sub '(Erste Spalte wird nicht berücksichtigt: Namensliste!)

Inhalt = Target.Value 'Inhalt der veränderten Zelle in Blatt 2

If Inhalt = "" Then Exit Sub

If IsNumeric(Left(Inhalt, 1)) Then Exit Sub '(an erster Stelle bitte die Spalte als Buchstabe!

Spalte = Columns(Left(Inhalt, 1)).Column 'Umwandeln Spalte von Buchstabe in Zahl

Zeile = Mid(Inhalt, 2) ' Nach dem Buchstaben kommt die Zeile

Worksheets("Tabelle1").Cells(Zeile, Spalte).Interior.ColorIndex = 3 ' 3 = rot

End Sub 'Worksheet_Change(ByVal Target As Range) {hotte-berlin}

Wenn jetzt in der Tabelle2 einen gültigen Matrixwert (z. B. A1) eingibst, färbt sich die enstprechende Zelle in Blatt1 rot.

Das funktioniert solange, wie die Spalten nicht über "X" hinausgehen, also nicht zweistellig werden.
Dann müsste man das Coding etwas anpassen.

Gruß
hotte-berlin

 

Hallo hotte-berlin,

Deine Lösung finde ich sogar noch einen Tick eleganter.
Vielen Dank für Deine Hilfe...

Eine Nachfrage noch (da man ja nie weiß ob man das nicht doch mal gebrauchen könnte):
Sollten die Spalten nun doch mal über "X" hinausgehen...wie muss man dann Deine Lösung abändern...?

Danke schon einmal...
tobi

 

Hallo Tobi,

es soll ja immer die gleiche Farbe gesetzt werden, oder?

Dann auch für Spalten jenseits Z dieses leicht abgewandelte Coding:

Option Explicit

Dim Inhalt As String
Dim Spalte As Byte
Dim Zeile As Byte

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 Then Exit Sub '(Erste Spalte wird nicht berücksichtigt: Namensliste!)

Inhalt = Target.Value 'Inhalt der veränderten Zelle in Blatt 2

If Inhalt = "" Then Exit Sub

If IsNumeric(Left(Inhalt, 1)) Then Exit Sub '(an erster Stelle bitte die Spalte als Buchstabe!


If IsNumeric(Mid(Inhalt, 2, 1)) Then

'bei einstelliger Spalte
Spalte = Columns(Left(Inhalt, 1)).Column 'Umwandeln Spalte von Buchstabe in Zahl
Zeile = Mid(Inhalt, 2) ' Nach dem Buchstaben kommt ab der zweiten Stelle die Zeilennummer

Else
'Bei zweistelliger Spalte:

Spalte = Columns(Left(Inhalt, 2)).Column
Zeile = Mid(Inhalt, 3) ' Nach den beiden Buchstaben kommt ab der dritten Stelle die Zeilennummer

End If

Worksheets("Tabelle1").Cells(Zeile, Spalte).Interior.ColorIndex = 3 '3 = rot

'Worksheets("Tabelle1").Cells(Zeile, Spalte).Interior.Color = 14922893 ' für Deine blaue Farbe wie in der Tabelle als Beispiel gesetzt

'mit dem Unterschied von '.color' und '.colorindex' habe ich mich noch nicht befasst!

End Sub 'Worksheet_Change(ByVal Target As Range) {hotte-berlin}