Zahl vor erste Zahl

Hey all,
Hatte ein Beitrag wegen Sortieren bei Zahlen und Text.
wollte noch dazu sagen, das ich den Beitrag von Yal versucht aber nicht hinbekommen habe.
zu dem Thema habe ich mir Folgenden Code gebastelt.
Der bewirkt das ich in jeder aktiven Zelle ab A3 er mir eine 0 voran schreibt wenn dort eine Zahl mit oder ohne Text schreibt.
dadurch kann ich das sortieren einfacher gestalten.


Sub Schaltfläche7_Klicken() ' eine 0 hinzufügen
Dim cc As Range
For Each cc In Selection
cc.NumberFormat = "@"
cc.Value = "0" & cc.Value
Next cc
ActiveSheet.Range("A1").Select
End Sub

jetzt zu meinem Problem,
leider bekomme ich es nicht hin das er mir alle auf einmal nur ab A3 nach unten findet. Ich muss jede Zelle einzeln anklicken zum ändern.
7 x 0,15
7 x 0,20
18 x 0,20
9 x 0,15
9 x 0,20
10 x 0,20
9 x 0,20
9 x 0,20
10 x 0,15
10 x 0,20
8 x 0,15
10 x 0,20
10 x 0,25
8 x 0,20
11 x 0,20
11 x 0,25
7 x 0,15
12 x 0,30
was muss ich an meinem Code ändern das er mir nur Spalte A automatisch durchsucht und bei nur 1 Zahl vorne dann die 0 noch voranstellt.
Bei meinem Code geht das über alle aktiven Zellen
Es wird nach der Ausführung sortiert.
Das selbe gilt für die 0 wieder entfernen.
da habe ich folgenden Code.


Sub Schaltfläche5_Klicken() ' 0 entfernen
Dim rngZ As Range
For Each rngZ In Selection.Cells
If Left(rngZ, 1) = 0 Then rngZ = Mid(rngZ, 2)
Next rngZ
ActiveSheet.Range("A1").Select
End Sub

Geht auch über alle aktiven Zellen, soll aber auch nur in ab A3 wieder auf einmal gehen nach dem Sortieren zwecks Übersicht.
7 x 0,15
7 x 0,20
8 x 0,15
8 x 0,20
9 x 0,15
9 x 0,20
10 x 0,15
10 x 0,20
10 x 0,25
11 x 0,20
11 x 0,25
12 x 0,30
Hoffe mal das ist nicht zu viel für euch
Bedanke mich schon mal im Voraus für eure Mühe
Mfg.
dieter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Hajo,
Erst mal Danke Deiner Antwort.
Ich glaube Du hast mich falsch verstanden.
Bei meinem Code löscht er mir nur die 0 bei Aktiver Zelle in alle Spalten.
Ich möchte aber das er mir nur in A die 0 vor der ersten Zahl löscht.
Den Fehler habe ich aber jetzt selbst gelöst.
Hast Du aber vielleicht eine Idee wie ich den Code ändern kann um ein 0 voran zu schreiben?


Sub Schaltfläche7_Klicken() ' eine 0 hinzufügen
Dim cc As Range
For Each cc In Selection
cc.NumberFormat = "@"
cc.Value = "0" & cc.Value
Next cc
ActiveSheet.Range("A1").Select
End Sub

Er soll mir nur in A wenn zB. nur eine Zahl steht eine 0 noch voran schreiben
7 x 0,20 ' hier 0
8 x 0,20 ' hier 0
15 x 0,15 ' hier keine 0
9 x 0,15 ' hier 0
9 x 0,20 ' hier 0
10 x 0,15 ' hier keine 0
10 x 0,25 ' hier keine o
12 x 0,30 ' hier keine 0
3 x 0,10 ' hier 0 hin
usw.
immer da wo Beispiel oben
Der Code müsste denke so aussehen,
suchen alle in Spalte A nur erste Zahl, da wo nur eine Zahl steht eine 0 voran schreiben
Code nach Ausführung wieder verlassen
Danke der Mühe
Mfg. Dieter

Sub NullDavorUndWeg() Dim lngZeile As Long For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) If Left(Cells(lngZeile, 1), 1) 0 Then Cells(lngZeile, 1) = "0" & Cells(lngZeile, 1).Value Else Cells(lngZeile, 1) = Mid(Cells(lngZeile, 1), 2) End If Next lngZeile End Sub

Public Sub Schaltfläche7_Klicken() Dim objCell As Range For Each objCell In Selection With Cells(objCell.Row, 1) If InStr(1, .Text, "x", vbTextCompare) > 0 Then .Value = _ IIf(Len(Trim$(Split(.Text, "x", , vbTextCompare)(0))) = 1, "0", vbNullString) & .Text End With Next End Sub

Public Sub Schaltfläche10_Klicken() Dim objCell As Range For Each objCell In Selection With Cells(objCell.Row, 1) If InStr(1, .Text, "x", vbTextCompare) > 0 Then .Value = _ IIf(Len(Trim$(Split(.Text, "x", , vbTextCompare)(0))) = 1, "0", vbNullString) & .Text End With Next End Sub

Public Sub Schaltfläche7_Klicken() Dim objCell As Range For Each objCell In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) With objCell If InStr(1, .Text, "x", vbTextCompare) > 0 Then .Value = _ IIf(Len(Trim$(Split(.Text, "x", , vbTextCompare)(0))) = 1, "0", vbNullString) & .Text End With Next End Sub

Public Sub Schaltfläche7_Klicken() Dim objCell As Range For Each objCell In Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp)) With objCell If .Text Like "# x #*" Then .Value = _ IIf(Len(Trim$(Split(.Text, "x", , vbTextCompare)(0))) = 1, "0", vbNullString) & .Text End With Next End Sub

Public Sub Schaltfläche7_Klicken() Dim objCell As Range For Each objCell In Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp)) With objCell If .Text Like "# x #*" Or .Text Like "#x #*" Or _ .Text Like "# x#*" Or .Text Like "#x#*" Then .Value = "0" & .Text End With Next End Sub

Public Sub Schaltfläche8_Klicken() Dim objCell As Range For Each objCell In Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp)) With objCell If Left$(.Text, 1) = "0" Then .Value = Mid$(.Text, 2) End With Next End Sub

Public Sub Schaltfläche7_Klicken() Dim objCell As Range For Each objCell In Range(Cells(3, 1), Cells(Rows.Count, 1).End(xlUp)) With objCell If Instr(Replace(.Value, " ", ""), "x") = 2 then .Value = "0" & .Value End With Next End Sub

Sub NullDavorUndWeg() Dim lngZeile As Long For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) If Left(Cells(lngZeile, 1), 1) = 0 Then Cells(lngZeile, 1) = Mid(Cells(lngZeile, 1), 2) Else If Len(Split(Cells(lngZeile, 1), " ")(0)) = 1 Then Cells(lngZeile, 1) = "0" & Cells(lngZeile, 1).Value End If End If Next lngZeile End Sub

Public Sub Selektion_sortieren() Nullen_setzen "00" With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Selection.Range("A1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Selection .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Nullen_setzen "0" End Sub Private Sub Nullen_setzen(Optional strNullen = "00") Dim Z As Range Dim Arr For Each Z In Selection Arr = Split(Z.Value, "x") Z = Format(Trim(Arr(0)), strNullen) & " x " & Trim(Arr(1)) Next End Sub

Sub NullDavorUndWeg() Dim lngZeile As Long Dim strText For lngZeile = 3 To IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) If Left(Cells(lngZeile, 1), 1) = 0 Then Cells(lngZeile, 1) = Mid(Cells(lngZeile, 1), 2) Else strText = Split(Cells(lngZeile, 1), "x") If Len(Trim(Split(Cells(lngZeile, 1), "x")(0))) = 1 Then strText(0) = "0" & Trim(strText(0)) strText(1) = Trim(strText(1)) Cells(lngZeile, 1) = Join(strText, " x ") End If End If Next lngZeile End Sub

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zahl vor erste Zahl

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread