vor kurzem hat man mir hier geholfen das u.a. Makro zum laufen zu bringen. Danke nochmal. Allerdings möchte ich in der Zeile
Call VerkettenMitFormat(Zelle, Zelle.Offset(0, 2).Resize(1, 8), " / ")
mit dem " / " verketten. Problem: Verkettet werden Zahlenwerte von 0 bis 20. Stehen nur zwei Zahlenwerte (z.b. 11 / 11) ergibt das im Ergebnis ein unerwünschtes Datum von 11. Nov. Es soll aber 11 / 11 bleiben.
Ich hatte auch versucht das Format der Ziel-Zellen vorab als Text zu formatieren, was aber nichts gebracht hat.
Kann man das evtl. in das Makro implementieren?
Für Hilfe wäre ich dankbar....
VG
willoserus
Sub test()
Dim Zelle As Range
Dim zeilen As Long
zeilen = Cells(Rows.Count, 10).End(xlUp).Row ' das ist Spalte J
For Each Zelle In Range("H6:H" & zeilen)
Call VerkettenMitFormat(Zelle, Zelle.Offset(0, 2).Resize(1, 8), " / ")
Next
End Sub
Sub VerkettenMitFormat(Ziel As Range, Quelle As Range, Optional TrKZ As String = "")
' die verketteten Zahlen werden im originalformat angegeben
Dim Zelle As Range
Dim txt As String
Dim Pos1 As Long
Dim LängeTRKZ As Long
Dim Länge As Long
LängeTRKZ = Len(TrKZ)
For Each Zelle In Quelle
If Zelle.Text "" Then
txt = txt & TrKZ & Zelle.Text
End If
Next
Ziel.Value = Mid(txt, LängeTRKZ + 1)
Pos1 = 1
For Each Zelle In Quelle
If Zelle.Text "" Then
With Ziel.Characters(Start:=Pos1, Length:=Len(Zelle.Text))
.Font.Name = Zelle.Font.Name
.Font.Size = Zelle.Font.Size
.Font.FontStyle = Zelle.Font.FontStyle
.Font.Italic = Zelle.Font.Italic
.Font.Color = Zelle.Font.Color
.Font.Strikethrough = Zelle.Font.Strikethrough
.Font.Subscript = Zelle.Font.Subscript
.Font.Superscript = Zelle.Font.Superscript
.Font.Underline = Zelle.Font.Underline
End With
Pos1 = Pos1 + Len(Zelle.Text) + LängeTRKZ
End If
Next
End Sub