Zellenwert rechtsbündig aufteilen
27.10.2003 08:17:16
ewald
folgendes Makro (vom Dan) teilt den Zellenwert in die Nachbarzellen
linksbündig, möchte aber, das dass Makro rechtsbündig teilt.
Wenn man in den folgenden zwei Zeilen die Zahlen ändert auf - 4 und -3,
dann wird rechtsbündig geteilt aber nur für eine Zahl z. B. 0,88 nich für 12,03
da funktioniert es nicht.
Wenn man stattdessen -5 und -4 eintippt funktionirt es für eine Zahl wie
z. B. 12,03 nicht aber für 0,88.
NeueSp% = Zelle.Column + WertLen% - 2
Else
NeueSp% = Zelle.Column + WertLen% - 1
Kann man das Makro so flexibel gestalten das es gleich ist, ob eine
oder zwei Zahlen vor dem Komma stehen?
Das ganze Makro:
Sub ZellenAufteilen()
Dim Wert$, WertLen%, CharNr%, Char$, NeueSp%, Zelle As Range, Zellen As Range
' testen ob zellen ausgewahlt sind
If (TypeName(Application.Selection) <> "Range") Then
MsgBox "Keine Zellen ausgewahlt.": End
Else
' referenz an die ausgawahlte selection setzen
Set Zellen = Application.Selection
End If
Selection.NumberFormat = "0"
' alle zellen durchgehen und Wert$ In Einzelne Zellen Aufteilen
For Each Zelle In Zellen
Wert$ = CStr(Zelle.Value)
WertLen% = Len(Wert$)
' wenn ein Komma da ist, brauchen wir eine zelle weniger
If (InStr(1, Wert$, ",")) Then
' in diese spalte wird der neue character eingefugt
NeueSp% = Zelle.Column + WertLen% - 2
Else
NeueSp% = Zelle.Column + WertLen% - 1
End If
' fur jeden character in Wert$, beginnend mit dem letzten
For CharNr% = -WertLen% To -1
Char$ = Mid(Wert$, -CharNr%, 1)
' testen, ob es sich um Komma handelt oder nicht
If (Char$ <> ",") Then
Cells(Zelle.Row, NeueSp%).Value = Char$
NeueSp% = NeueSp% - 1
Else
Cells(Zelle.Row, NeueSp% + 1).Value = Char$ & Cells(Zelle.Row, NeueSp% + 1).Value
End If
Next CharNr%
Next Zelle
End Sub
Es wäre schön wenn mir jemand helfen könnte.
Herzlichen Dank im Voraus.
Grüße