Excel VBA mehrere Zellen formatieren

Computer: Software & Programmierung Visual Basic
#1

Hallo Zusammen,

Versuche gerade ein kleines Prog. zu basteln, welches mir die Daten in Excel formatiert.

Jedoch hab ich hier ein kleines Problem und wollte euch bitten,
mir hierbei evtl. kurz behilflich zu sein.

Ausgangssituation:

In Excel werden aus verschiedenen Programmen Daten exportiert in diesem Format

0.123.456.789.abc, 0.123.h45.k67.13e usw…

Also dreizehnstellige Zahlen und Buchstaben mit Punkten.

Ich möchte diese nun so formatieren dass sie nur noch 10-stellig sind ohne Punkt.
0123456789.

Jedoch nur die Zahlen, welche ich e zuvor im Excelblatt markiert habe.

Habe hierzu auch schon etwas probiert:

Sub Entfernen()

Dim Markierung
Dim zelle As Range
Dim tabs Weis ich nicht ganz wie ich deklarieren soll

Markierung=Selection.Address(0,0)
Range(Markierung).Select
Selection.NumberFormat = „0000000000“
Selection.Replace What:=".", Replacement:="", lookAt:=xlPart,_
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

On Error Resume Next
Application.ScreenUpdating = False
For Each zelle In Range(Markierung)
zelle= left(zelle,Len(zelle)-3)
Next
Application.ScreenUpdating = True

End Sub

Bei ca. 80% der Datensätze funktioniert das. Jedoch habe ich noch recht viele Fälle wo
Sachen wie 1,23456789E ausgegeben werden oder gar nichts passiert, je nachdem wie sie durch das jeweilige Programm formatiert sind.

Gibt es eine Möglichkeit, unabhängig der Ausgangsformatierung dies zu realisieren, also 10-stellige Zahl (wichtig auch mit vorhergehender 0 also 0123456789) ausgeben?

Vielen Dank im Voraus für eure Hilfe.

#2

Ja. Das Grundproblem könnte nicht das Programm sein, sondern die Zellenformatierung in Excel selbst. Markiere doch mal die Ganze Spalte und setzte diese unter der Rubrik „Zellen formatieren…“ im Kontextmenü der Maus, in der Registerkarte Zahlen von der Kathegorie Standard auf die Kathegorie Text.
Grüsse Sebastian

#3

Hi,

danke für die schnelle Antwort.
Ja, das hatte ich schon probiert.
Sobald ich auf Format Text ändere, ändert sich bei manchen das Zahlenformat.
In Text umwandeln wäre gut, da somit ja die führende 0 beibehalten wird.

#4

Schnell die Spalte exportieren in den Editor und wieder in die Textspalte importieren ginge auch nicht?

#5

Hallo Questos,
du musst erst durch die Formatierung der Daten errreichnen, dass diese einheitlich sind. Dann in der ‚for each‘-Schleife left(x,10) statt left(x,len(x)-3).

Deine Zahl 1,23456789E würde ich als 1,23456789E±XX deuten, bei der die ±XX weggeschnitten wurden. Es ist Scientific-Format, den du durch festlegen des Formates mit ‚NumberFormat = „0000000000“‘ eigentlich eliminiert haben musst.
(mit ± meine ich entweder + oder -)
Schau dir die 'Hartnäckige Daten genauer an,dass diese z.B. :- keine führende Leerzeichen haben

  • keine Exponenten haben (das XX nach E±)

MfG.
W.W.

#6

Hallo,

sie dir diesen tread an,
http://www.ozgrid.com/forum/showthread.php?t=64982

gruß fred

#7

Hallo,

vielleicht solltest Du mal versuchen, die Angaben als String zu formatieren.

Gruß,
Ptonka

#8

Hallo Questos,

ich habe zwar lange experimentiert, finde aber leider keine passende Lösung.

Gruß Hugo

#9

Hallo Questos,

probiere mal die folgenden Varianten.

Gruß
Franz

Sub Entfernen()

 Dim Markierung As Range
 Dim zelle As Range, strWert As String

 Set Markierung = Selection

 Markierung.NumberFormat = "0000000000"

 On Error Resume Next
 Application.ScreenUpdating = False
 For Each zelle In Markierung
 strWert = zelle.Text
 strWert = VBA.Replace(strWert, ".", "")
 If Len(strWert) \> 3 Then
 strWert = Left(strWert, Len(strWert) - 3)
 If IsNumeric(strWert) Then zelle = CLng(strWert)
 End If
 Next
 Application.ScreenUpdating = True

End Sub

'oder: Werte bleiben als Text in Zellen stehen

Sub Entfernen\_2()

 Dim Markierung As Range
 Dim zelle As Range, strWert As String

 Set Markierung = Selection

 On Error Resume Next
 Application.ScreenUpdating = False
 For Each zelle In Markierung
 strWert = zelle.Text
 strWert = VBA.Replace(strWert, ".", "")
 If Len(strWert) \> 3 Then
 strWert = Left(strWert, Len(strWert) - 3)
 zelle = "'" & strWert
 End If
 Next
 Application.ScreenUpdating = True

End Sub