Replace Funktion erweitern

[Wulfi]

Hallo Uwe,
den Gedanken hatte ich auch schon. Geht aber leider nicht.
Zuerst hatte ich es so gemacht, wie du mit den ? vorschlägst:
000001#Dies ist ein Beispielsatz.
Alles super! Mit der Raute als Delimiter kann man ja auch super trennen. Text in Spalten usw.

Dann lasse ich die Raute weg und der Satz fliegt auseinander.
Mach ich das dann mit * geht noch mehr kaputt.
Ergo: Das Problem ist hier irgendwie das Leerzeichen zwischen dem feststehenden
Zahlenformat und dem dahinter folgendem Text.

[Steffl]

Hallo Wulfi,

hier mal mein RegEx-Versuch (zumindest hat es mit deinem Testdaten funktioniert)

PHP-Code:

Sub prcTestRegex()
   Dim re As Object
   Dim lngC As Long
   
   Set re = CreateObject("vbscript.regexp")
   re.Pattern = "^[0-9]+ "
   lngC = 1
   While Cells(lngC, 1) <> ""
      Cells(lngC, 2) = re.Replace(Cells(lngC, 1).Value, "")
      lngC = lngC + 1
   Wend
End Sub 


[Kuwer]

Hallo Wulfi,

ich habe nicht wirklich verstanden, was Du mir sagen wolltest.
Bei mir funktioniert das so mit Deinen Testdaten.

Aber wenn, wie ich gerade bei Stefan sah, auch Schleifen ins Spiel kommen,
ginge auch sowas:

Code:

Sub ZahlenRaus()
  Dim i As Integer
  With Selection
    For i = 0 To 9
      .Replace What:=i, Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next i
    .Replace What:=" ", Replacement:="", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
  End With
End Sub

Gruß Uwe

[Wulfi]

Hallo Leute,

der Ansatz von Uwe schein zu funktionieren und der von Stefan klemmt noch etwas.

Muss mich erstmal ins Wochenende verabschieden.
Bis dann und schon mal vielen Dank!

[Steffl]

Hallo,

wo klemmt es bei meinem Ansatz? Den gekürzten Zellinhalt schreibt das Makro in die zweite Spalte. Wenn Du das nicht willst, kannst Du es doch in die erste Spalte schreiben.

[LoreHaubrich]

Hallo Leute,
ich habe ein kleines Testprogramm geschrieben:

Code:

Sub Replace_Test()
Columns(ActiveCell.Column).Select
For Each zelle In Selection
zelle.Value = Format(zelle.Row, "0000000") & " " & "Dies ist ein Beispielsatz"
Next zelle
End Sub

und muss sagen, dass der Code bei euch beiden noch nicht richtig funktioniert.
Bei Uwe müsste im 2. Replacement ein Leerzeichen stehen also
.Replace What:=" ", Replacement:=" ", LookAt:=xlPart,_
dann schließt der Text aber immer noch nicht linksbündig ab und das Ganze ist sehr langsam.
Besser geht's mit den regulären Ausdrücken von Stefan bzw. ist richtig schnell. Programm hängt
sich aber leider auf.

[Steffl]

Hallo,

und muss sagen, dass der Code bei euch beiden noch nicht richtig funktioniert.
Bei Uwe müsste im 2. Replacement ein Leerzeichen stehen also
.Replace What:=" ", Replacement:=" ", LookAt:=xlPart,_
dann schließt der Text aber immer noch nicht linksbündig ab und das Ganze ist sehr langsam.
Besser geht's mit den regulären Ausdrücken von Stefan bzw. ist richtig schnell. Programm hängt
sich aber leider auf.

Das ist klar. Dein Beispiel besteht neben den Zahlen aus mehreren Wörtern mit jeweils einem Leerzeichen dazwischen. Das war aber in dem Beispiel von wulfi nicht enthalten.

Bei meinen Teil: Ich konnte beim Testen nicht feststellen, das sich das Programm aufhängt. Es dauert sehr lange und am Ende kommt eine Fehlermeldung. Du füllst aber mit deinem Beispielprogramm eine ganze Spalte und wenn Du eine Excelversion 2007 oder höher hast, hast Du ja über eine 1 Mio Zeilen und das das dann dauert, dürfte klar sein.

[Kuwer]

Hallo,

hier noch zwei Varianten mit VBA-Boardmitteln:

Code:

Option Explicit

Const iZ As Long = 65000  'Anzahl Zellen für alle Makros

Sub SpalteFuellen()
  Dim i As Long
  Dim varT() As Variant
  ReDim varT(1 To iZ, 1 To 1)
  For i = 1 To iZ
    varT(i, 1) = "12345 Das ist ein beispielhafter Text " & Format(i, "000000")
  Next i
  Cells(1, 1).Resize(iZ, 1).Value = varT
End Sub

Sub ReplaceFest()
  Const iStart As Long = 7  'Text bleibt ab der 7. Stelle erhalten
  Dim i As Long
  Dim varT As Variant
  varT = Cells(1, 1).Resize(iZ, 1).Value
  For i = 1 To iZ
    varT(i, 1) = Mid(varT(i, 1), iStart)
  Next i
  Cells(1, 1).Resize(iZ, 1).Value = varT
End Sub

Sub ReplaceVariabel()
  Const strTrennzeichen As String = " " 'Text bleibt ab 1. Leerzeichen erhalten
  Dim i As Long
  Dim varT As Variant
  varT = Cells(1, 1).Resize(iZ, 1).Value
  For i = 1 To iZ
    varT(i, 1) = Mid(varT(i, 1), InStr(1, varT(i, 1), strTrennzeichen) + 1)
  Next i
  Cells(1, 1).Resize(iZ, 1).Value = varT
End Sub

Gruß Uwe

[kathrin-Flint]

Hi Leute,
anbei die bislang optimalste Lösung:

Code:

Private Declare PtrSafe Function GetTime Lib "winmm.dll" Alias "timeGetTime" () As Long

Sub A_ReplaceReguläreAusdruecke()
Dim re As Object
Dim i As Long
Dim varT As Variant
Dim vbT1 As Long
vbT1 = GetTime
Const iZ As Long = 65500
Set re = CreateObject("vbscript.regexp")
re.Pattern = "^[0-9]+ "
varT = Cells(1, 1).Resize(iZ, 1).Value
For i = 1 To iZ
    varT(i, 1) = re.Replace(varT(i, 1), "")
Next i
Cells(1, 1).Resize(iZ, 1).Value = varT
MsgBox "Zeit = " & GetTime - vbT1
End Sub

1. Der Code von Stefan bietet die beste Variabilität
2. Der Code von Uwe ist am schnellsten

Habe mal die Zeit gemessen
1. Die while Schleife ist am langsamsten
2. mit For Each ca. 30 % schneller
3. mit Feldern reduziert sich die Zeit auf 1/8 oder weniger.

Für zukünftige Programmieraufgaben sicherlich interessant.

[Kathrin Doppelbauer]

Hallo meine Lieben,

wie lösche ich mittels eines regulären Ausdruckes alle dreistelligen Zahlen in meinem Text?