AW: Tabelle neu anordnen
23.11.2016 22:13:41
Fennek
Hallo,
Sub Jenny()
i = 1
Columns("C:E").Clear
With ActiveSheet.UsedRange.Columns(1).SpecialCells(2)
For Each Ar In .Areas
Ar.Cells(1).Copy Cells(i, 3)
Range(Ar.Cells(2), Ar.Cells(1).Offset(Ar.Count - 1)).Copy Cells(i, 4)
'Debug.Print Ar.Count
i = i + Ar.Count - 1
Next Ar
End With
Columns(4).TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
y = Columns("E").Replace(")", "")
lr = Cells(Rows.Count, 4).End(xlUp).Row
Range("C1:C" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("C1:C" & lr).Copy
Cells(1, 3).PasteSpecial xlValues
'Nicht schön, sollte aber funktionieren (ungeprüft)
for i = 1 to lr
if left(cells(i,"D") = "-" then
cells(i, "D") = right(cells(i, "D"), len(cells(i, "D"))-1)
end if
next i
End Sub