|
Hallo Stefan,
versuch mal:
Option Explicit
Sub Andromoney_konvertieren()
Dim loLetzte As Long, raBereich As Range, raZelle As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle1") 'Blattnamen anpassen
'letzte Zeile Spalte A ermitteln
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
'Bereich von A1 bis A letzte belegte Zelle definieren
Set raBereich = .Range(.Cells(1, 1), .Cells(loLetzte, 1))
'Prüfung ob Daten in Spalte A vorhanden
If loLetzte = 1 And IsEmpty(.Cells(1, 1)) Then
MsgBox "Keine Daten in Spalte A"
Exit Sub
End If
'Text trennen
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
'Punkte durch Komma ersetzen in Beträgen
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
'Format der Währung ändern (Text->Währung)
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
Gruß Werner
|