Anzeige
Archiv - Navigation
1060to1064
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro Format übertragen-Schriftfarbe erhalten

Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 08:45:11
Andi
Hallo liebe Community,
ich habe folgendes Problem und suche nach einem Tipp dieses zu lösen.
Vereinfacht gesagt habe ich ein Makro, dass das Format der Zelle A1 auf die Zelle C1 übertragen soll.
Jetzt habe ich aber das Problem, dass die Schriftfarbe der Zelle C1 erhalten bleiben soll.
Wie kann ich Excel beibringen, dass zwar Rahmen, bedingte Formatierung, Größe, Schriftart, Ausrichtung usw. übertragen werden soll, nicht aber die Schriftfarbe?
Im Hoffen auf eure Hilfe
Andi

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 08:47:15
Hajo_Zi
Hallo Andi,
imdem Du jede Eigenschaft einzel übertragst oder Dir die Schriffarbe merkst und Sie am Schluss wieder setzt.

AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 08:50:05
Andi
Hallo, danke für die fixe Antwort.
Die Schriftfarbe zu merken ist leider zu kompliziert, da dieser Vorgang bei 23.000 Zellen durchgeführt wird.
Wie kann ich denn Eigenschaften einzeln übertragen?
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 09:31:04
D.Saster
Hallo,

Die Schriftfarbe zu merken ist leider zu kompliziert,


das dürfte einfacher sein, als die Eigenschaften einzeln zu übertragen.
Wie sieht das denn konkret aus?
Gruß
Dierk

Anzeige
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 09:36:26
Andi
Hallo,
ich habe eine Arbeitsmappe mit ~20 Blättern.
In diesen 20 Blättern tragen Mitarbeiter Daten ein und verändern durch simples "Rein-Kopieren" ständig die Formatierung. Nun möchte ich einfach das richtige Format "drüberbügeln".
Allerdings ist die Schriftfarbe in den Zellen unterschiedlich und muss erhalten werden. In einer Zelle können bei knapp 70 Zeichen bis zu 3 Farben vorkommen.
Bisher übertrage ich das Format aus einem Vorlagenblatt in den Zielbereich A100:M1000. Die Blätter sind alle gleich aufgebaut.
Wie schaffe ich es denn, dass ich die Farben "zwischenspeicher"?
Ich hoffe ich konnte dir beschreiben was ich meine.
Vielen Dank schon einmal.
Gruß
Andi
Anzeige
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 10:12:31
D.Saster
Hallo,

In einer Zelle können bei knapp 70 Zeichen bis zu 3 Farben vorkommen.


das ist grob.
Da fällt mir nur ein, die Formate jeder Zelle einzeln zu übertragen und sich vorher die Farbe jedes einzelnen Zeichens zu merken. Das dauert.
Muster:


Function TextColors(rng As Range)
Dim i As Integer, vntColors
ReDim vntColors(1 To Len(rng))
For i = 1 To Len(rng)
vntColors(i) = rng.Characters(i, 1).Font.ColorIndex
Next
TextColors = vntColors
End Function
Sub tt()
Dim arrColors()
Dim wksVorlage As Worksheet, wksZiel As Worksheet
Dim iRow As Long, iCol As Long, i As Integer
Application.ScreenUpdating = False
Set wksVorlage = Sheets("Vorlage")
Set wksZiel = Sheets("Tabelle2")
For iRow = 100 To 1000
For iCol = 1 To 13
If Len(wksZiel.Cells(iRow, iCol)) > 0 Then
arrColors = TextColors(wksZiel.Cells(iRow, iCol))
End If
wksVorlage.Cells(iRow, iCol).Copy
wksZiel.Cells(iRow, iCol).PasteSpecial xlFormats
If Len(wksZiel.Cells(iRow, iCol)) > 0 Then
For i = 1 To Len(wksZiel.Cells(iRow, iCol))
wksZiel.Cells(iRow, iCol).Characters(i, 1).Font.ColorIndex = arrColors(i)
Next
End If
Next
Next
Application.ScreenUpdating = True
End Sub

Gruß
Dierk

Anzeige
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 10:34:39
Andi
Hallo,
ihr habt recht, das wird einfach zu aufwendig.
Ich habe es jetzt so "gelößt", dass ich die Formatierung per Code einfach setze ohne zu kopieren.
vielen Dank für alle Antworten!
Zusatz zur vorherigen Antwort
25.03.2009 09:49:52
Chris
hae irgendie nicht ganz das geschrieben, was ich eigentlich sagen wollte ... da fehlte noch ein kleiner ANhang:
Bei diesem Ansatz kopiere ich auch eigenschafften mit. Sollte also auch als Ansatz funktionieren, wenn Du so Eigenschafften einer Zelle in die Du kopierst erhalten willst...
Leider finde ich den Code nicht um in dier hochzuladen, da es schon etwas her ist, dass ich es geschrieben habe..
Gruß
Chris
Anzeige
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 09:35:16
Chris
kopierst Du die ganze Spalte, oder die zellen einzeln?
Ich habe was gemacht was dir als Ansatz evtl helfen könnte.
Ich ermittel die letze beschreiben Zeile einer Spalte und kopier über eine For-Next-Schleife alle zellen einzeln bis zur letzen beschreibenen zeile.
Konkreter Antworten wären möglich, wenn du deinen Code mal hochlädst.
Gruß Chris
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 09:59:39
Andi
Hallo,
weißt du noch wie du es geschafft hast nur Rahmen und bedingte Formatierung zu übertragen.
Das ist nämlich das was ich brauche!
Gruß!
AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 10:53:11
Chris
Ich kann mich leider nicht mehr wirklich dran erinnern, aber ich habe mal eben was mit hilfe des Marcro-recorders ausprobiert für die Rahmen funktioniert es.. kann aber bestimmt ganz sicher noch verbessert werden. Musst Du nur noch deinem Programm anpassen.

Sub Rahmen
Range("L15").Select
Unten = Selection.Borders(xlDiagonalDown).LineStyle
oben = Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
a = .LineStyle: b = .Weight: c = .ColorIndex
End With
With Selection.Borders(xlEdgeTop)
a1 = .LineStyle:b1 = .Weight:c1 = .ColorIndex
End With
With Selection.Borders(xlEdgeBottom)
a2 = .LineStyle: b2 = .Weight:c2 = .ColorIndex
End With
With Selection.Borders(xlEdgeRight)
a3 = .LineStyle:b3 = .Weight: c3 = .ColorIndex
End With
Range("K20").Select
Selection.Borders(xlDiagonalDown).LineStyle =Unten
Selection.Borders(xlDiagonalUp).LineStyle = oben
With Selection.Borders(xlEdgeLeft)
.LineStyle = a:.Weight = b:.ColorIndex = c
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = a1: .Weight = b1:ColorIndex = c1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = a2: .Weight = b2: .ColorIndex = c2
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = a3: .Weight = b3: .ColorIndex = c3
End With
End Sub


Ähnlich sollte es mit den anderen bedingten Formatierungen funktionieren, allerdings kommt gleich ein Kunde und mir fehlt gerade die Zeit suchen oder rauszufinden und zu testen.
Ja nach Zellenanzahl dauert es zwar eine Weile, geht aber immer noch schneller als manuell ;-)
Gruß
Chris

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige