Option
Explicit
Sub
Andromoney_konvertieren()
Dim
loLetzte
As
Long
, raBereich
As
Range, raZelle
As
Range
Application.ScreenUpdating =
False
With
Worksheets(
"Tabelle1"
)
loLetzte = .Cells(.Rows.Count, 1).
End
(xlUp).Row
Set
raBereich = .Range(.Cells(1, 1), .Cells(loLetzte, 1))
If
loLetzte = 1
And
IsEmpty(.Cells(1, 1))
Then
MsgBox
"Keine Daten in Spalte A"
Exit
Sub
End
If
raBereich.TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=
False
, Tab:=
False
, _
Semicolon:=
False
, Comma:=
True
, Space:=
False
, Other:=
False
, FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 1), _
Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2) _
, Array(14, 2)), TrailingMinusNumbers:=
True
loLetzte = .Cells(.Rows.Count, 3).
End
(xlUp).Row
Set
raBereich = .Range(.Cells(1, 3), .Cells(loLetzte, 3))
raBereich.Replace What:=
"."
, Replacement:=
","
, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=
False
, SearchFormat:=
False
, _
ReplaceFormat:=
False
For
Each
raZelle
In
raBereich
raZelle =
CDbl
(raZelle)
Next
raZelle
.Columns(
"C:C"
).NumberFormat =
"#,##0.00 $"
End
With
Set
raBereich =
Nothing
Application.ScreenUpdating =
True
End
Sub