VBA Activen Bereich für resize in Range wählen
19.08.2015 09:00:54
willoserus
ich habe per google ein fast passendes Makro gefunden, was meinen Wünschen entspricht. Allerdings werden in Zeile 4 beim resize Befehl statisch nur die ersten vier Zellen verkettet.
Ich habe einen festen Bereich in der Zeile von J-AC, in dem verschieden viele Zellen (mal nur eine bis hin zu 20) mit Werten sein können, und nur die möchte ich über ein Komma verketten. Mit anderen Worten: Bei festen Werten habe ich sonst am Ende eine Menge überflüssiger Kommata ;-)
Für Hilfe wäre ich dankbar.
Das ist das Makro
hier gefunden: http://www.office-loesung.de/ftopic577603_0_0_asc.php
Sub test()
Dim Zelle As Range
For Each Zelle In Range("H6:H" & Cells(Rows.Count, 10).End(xlUp).Row)
Call VerkettenMitFormat(Zelle, Zelle.Offset(0, 2).Resize(1, 4), ",")
Next
End
Sub
Sub VerkettenMitFormat(Ziel As Range, Quelle As Range, Optional TrKZ As String = "")
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
txt = txt & TrKZ & Zelle.Text
Next
Ziel.Value = Mid(txt, LängeTRKZ + 1)
Pos1 = 1
For Each Zelle In Quelle
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
Next
End Sub