Hallo,
vielen Dank schon mal für die Unterstüzung
Die verschiedenen Numberformate (General oder Number) hab ich im aktuellen Makro schon drinbzw. getestet. (das oben war auch nur der Auszug wo das Problem besteht.)
Hab das auch mit der For-Schleife versucht, aber auch hier das selbe, die Zahlen bleiben als "Text" in der Zelle.
Hier das ganze Makro, in der Mitte (nach Selection.Autofilter) die Sachen die ich nun alle schon versucht habe aber immer das selbe Problem.
Excel selbst brint ja auch den den hinweis bei den Zellen "Die Zahl in dieser Zelle ist als Text formatiert....", obwohl im Format-Dropdown "Standard" steht.
Dim startPunkteReihe As Integer
Dim endePunkteReihe As Integer
Dim startPunkteSpalte As Integer
Dim endePunkteSpalte As Integer
Dim c As Range
Dim r As Range
startPunkteSpalte = 1
cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
startPunkteReihe = Selection.Row
endePunkteReihe = startPunkteReihe + Selection.Rows.Count - 1
startPunkteSpalte = Selection.Column
endePunkteSpalte = startPunkteSpalte + Selection.Columns.Count - 1
Selection.AutoFilter
Set c = Range(cells(startPunkteReihe, startPunkteSpalte), cells(startPunkteReihe, endePunkteSpalte))
Set c = c.Find("Laenge")
If Not c Is Nothing Then
Set r = Range(c, c.Offset(endePunkteReihe - startPunkteReihe, 1))
r.NumberFormat = "General"
Dim abc As Range
For Each abc In r.Offset(1, 0)
abc.Value = Left(abc.Value, Len(abc.Value) - 3)
Next
' r.Replace What:=" mm", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
c.Offset(-1, 0).Value = 1
c.Offset(-1, 0).Copy
c.Offset(2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
c.Offset(-1, 0).Formula = "=SUBTOTAL(9," & r.Columns(1).Address & ")"
Else
MsgBox ("Spalte ""Länge"" nicht gefunden")
End If
Columns("A:A").ColumnWidth = 33.29
Columns("B:B").ColumnWidth = 33.86
|