VBA: Zellformat übertragen waagerecht und senkrecht

08/03/2009 - 17:53 von Ralf Brinkmann | Report spam
Hallo!

Eine Frage an die, die schon den schwarzen Gürtel in VBA haben... :-)

Zwei Blàtter, Blatt1 und Blatt2. Auf Blatt2 stehen in Zeile 1
nebeneinander jeweils die Buchstaben A bis E, immer wieder, von mir aus
auch bunt durcheinander.

In Blatt1 stehen in Zeile 1 ebenfalls die Buchstaben A, B, C, D und E.

Nun soll in Blatt1 nachgeguckt werden, welche Farbe die jeweilige Zelle
hat und auf die Zelle mit dem entsprechenden Buchstaben in Blatt2
übertragen werden.

Sowas funktioniert:

For Each Zelle In .Range("A1:AF1")
With Zelle
.Interior.ColorIndex = _
_Sheets("Blatt1").Range(Zelle.Value & "1").Interior.ColorIndex
.Font.ColorIndex = _
_Sheets("Blatt1").Range(Zelle.Value & "1").Font.ColorIndex
End With
Next

Was macht man aber, wenn die Buchstaben in Blatt1 nicht nebeneinander
stehen, sondern untereinander, zum Beispiel von A1 bis A5?

Gruß, Ralf
Windows XP Home SP3
Opera 10.00-1285
 

Lesen sie die antworten

#1 Andreas Killer
08/03/2009 - 18:24 | Warnen spam
Ralf Brinkmann schrieb:

Eine Frage an die, die schon den schwarzen Gürtel in VBA haben... :-)


Hmm, da fühl ich mich mal angesprochen. :-)))

Zwei Blàtter, Blatt1 und Blatt2. Auf Blatt2 stehen in Zeile 1
nebeneinander jeweils die Buchstaben A bis E, immer wieder, von mir aus
auch bunt durcheinander.
In Blatt1 stehen in Zeile 1 ebenfalls die Buchstaben A, B, C, D und E.

Nun soll in Blatt1 nachgeguckt werden, welche Farbe die jeweilige Zelle
hat und auf die Zelle mit dem entsprechenden Buchstaben in Blatt2
übertragen werden.

Sowas funktioniert:


Uuh oh puh, naja... aber nur wenn Deine Zellen Werte von "A" bis "IV"
enthalten und wenn nicht, was dann?

Was macht man aber, wenn die Buchstaben in Blatt1 nicht nebeneinander
stehen, sondern untereinander, zum Beispiel von A1 bis A5?


Such doch einfach nach dem Wert, dann ist es auch wurscht wo er steht.

Sub Test()
Dim Zelle As Range, C As Range
'Sicherstellen das wir nicht im Formatblatt sind
If ActiveSheet.Name = "Tabelle1" Then Exit Sub
'Bildschirmflackern aus
Application.ScreenUpdating = False
'Benutzten Bereich der aktiven Tabelle durchlaufen
For Each Zelle In ActiveSheet.UsedRange
'Wenn Zelle nicht leer, dann...
If Not IsEmpty(Zelle) Then
'...suche nach der Zelle in Tabelle1
Set C = Sheets("Tabelle1").Cells.Find(Zelle, LookAt:=xlWhole)
'Gefunden?
If Not C Is Nothing Then
'Ja, kopieren starten
C.Copy
'Komplettes Format auf Zielzelle übertragen
Zelle.PasteSpecial _
xlPasteFormats, xlPasteSpecialOperationNone
Else
'Formate löschen??
Zelle.ClearFormats
End If
End If
Next
'Kopiermodus aus
Application.CutCopyMode = False
'Bildschirm ein
Application.ScreenUpdating = True
End Sub

Andreas.

Ähnliche fragen