VBA: String nach der letzten Ziffer abschneiden

Forumthread: VBA: String nach der letzten Ziffer abschneiden

joerg

Hallo,
bestimmt ganz einfach, wenn man weiss wie's geht: Ich habe eine Reihe von Strings, zB 'abc_0323BAII' - wie kann ich von diesen die letzten Stellen abschneiden, so dass alles bis zur letzten Ziffer übrigbleibt? (Also, manche der Strings haben am Ende auch nur einen oder zwei oder gar keine Buchstaben... man müsste also irgendwie den String durchgehen, wohl am besten von hinten nach vorn, und solange Zeichen löschen bis man auf eine Ziffer trifft...?)
Danke & viele grüsse,
Jo

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: VBA: String nach der letzten Ziffer abschneiden

06.02.2010 10:38:56

Josef

Hallo Jo,

da gibt's viele Möglichkeiten.

Public Sub Test()
  Dim objRegEx As Object
  Dim strText As String

  strText = "abc_0323BAII"

  Set objRegEx = CreateObject("VBScript.RegExp")

  With objRegEx
    .MultiLine = True
    .Global = True
    .IgnoreCase = True
    .Pattern = "\D+"
    strText = .Replace(strText, "")
  End With

  MsgBox strText

End Sub

Gruß Sepp

Wäre das schnell?

06.02.2010 10:48:36

joerg

Hallo Sepp,
mal wieder ein fettes Danke!
Es geht dabei um die Dateinamen der Bilder, dabei hattest Du mir ja auch schon geholfen... Sind tatsächlich ca. 8000 Bilder, das Einbinden dauert schon ganz schön lange... Ich glaube, für diese Stringumwandlung bräuchte ich die schnellstmögliche Variante, ist das wohl die hier, mit der RegEx?
(Zur Erklärung: Die Dateinamen werden aus anderen Daten der Tabelle zusammengebaut. Leider ist aber die benennung der Dateien ein bischen uneinheitlich, sodass nur manche Dateinamen gekürzt werden müssen, und zwar nur dann, wenn die Datei mit Buchstaben nicht gefunden wird... )
Gruss,
Jo

AW: Wäre das schnell?

06.02.2010 11:01:24

Josef

Hallo Jo,

bezogen auf das gestrige Beispiel, würde das so aussehen.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub insertPicture()
  Dim strPath As String
  Dim rng As Range
  Dim objPic As Object
  Dim strFile As String, strName As String, strExt As String

  strPath = "E:\Temp" 'Verzeichnis - Anpassen!

  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

  With Sheets("Tabelle1") 'Tabellenname anpassen!
    For Each rng In .Range("A1:A100") 'Bereich anpassen!
      If rng <> "" Then
        strFile = Dir(strPath & rng, vbNormal)
        If strFile = "" Then
          strName = Left(rng, InStr(1, rng, ".") - 1)
          strExt = Mid(rng, InStr(1, rng, "."))
          strFile = Dir(strPath & onlyNumbers(strName) & strExt, vbNormal)
        End If
        If strFile <> "" Then
          Set objPic = .Pictures.Insert(strPath & strFile)
          objPic.Top = rng.Top
          objPic.Left = rng.Left + rng.Width - objPic.Width
        End If
      End If
    Next
  End With

End Sub

Function onlyNumbers(ByVal Text As String) As String
  Dim objRegEx As Object

  Set objRegEx = CreateObject("VBScript.RegExp")

  With objRegEx
    .MultiLine = True
    .Global = True
    .IgnoreCase = True
    .Pattern = "\D+"
    Text = .Replace(Text, "")
  End With

  onlyNumbers = Text

  Set objRegEx = Nothing
End Function

Gruß Sepp

AW: Wäre das schnell?

06.02.2010 11:43:11

joerg

Hallo Sepp,
ich hab's jetzt so gemacht:


Sub insertPicture()
Dim strPath As String
Dim rng As Range
Dim objPic As Object
Dim objRegEx As Object
Dim strText As String
Set objRegEx = CreateObject("VBScript.RegExp")
' RegEx initialisieren
With objRegEx
.MultiLine = True
.Global = True
.IgnoreCase = True
.Pattern = "\D+$"
End With
' Alle Bilder löschen
For InI = ActiveSheet.Shapes.Count To 1 Step -1
If Left(ActiveSheet.Shapes(InI).Name, 6) = "Grafik" Then
ActiveSheet.Shapes(InI).Delete
End If
Next
strPath = "C:\Documents and Settings\Administrator\My Documents\Kat\Bilder_klein"
If Right(strPath, 1)  "\" Then strPath = strPath & "\"
With Sheets("Gesamt") 'Tabellenname anpassen!
For Each rng In .Range("c1:c200") 'Bereich anpassen!
If rng  "" Then
If Dir(strPath & rng & ".jpg", vbNormal)  "" Then
Set objPic = .Pictures.Insert(strPath & rng & ".jpg")
objPic.Top = rng.Top
objPic.Left = rng.Left - objPic.Width
rng.Font.ColorIndex = 5
ElseIf Dir(strPath & objRegEx.Replace(rng, "") & ".jpg", vbNormal)  "" Then
rng.Font.ColorIndex = 7
Set objPic = .Pictures.Insert(strPath & objRegEx.Replace(rng, "") & ".jpg")
objPic.Top = rng.Top
objPic.Left = rng.Left - objPic.Width
End If
End If
Next
End With
End Sub

Ist ja so ungefähr dasselbe, oder?
Ich weiss jetzt nur nicht - so, wie's jetzt ist, wird ja die RegEx u.U. zweimal angewendet, einmal im ElseIf und dann nochmal beim Set... wäre es so besser / schneller, oder so:


With Sheets("Gesamt") 'Tabellenname anpassen!
For Each rng In .Range("c1:c200") 'Bereich anpassen!
If rng  "" Then
strText = objRegEx.Replace(rng, "")
If Dir(strPath & rng & ".jpg", vbNormal)  "" Then
Set objPic = .Pictures.Insert(strPath & rng & ".jpg")
objPic.Top = rng.Top
objPic.Left = rng.Left - objPic.Width
rng.Font.ColorIndex = 5
ElseIf Dir(strPath & strText & ".jpg", vbNormal)  "" Then
rng.Font.ColorIndex = 7
Set objPic = .Pictures.Insert(strPath & strText & ".jpg")
objPic.Top = rng.Top
objPic.Left = rng.Left - objPic.Width
End If
End If
Next
End With

Wobei bei der zweiten Variante die RegEx auch dann ausgewertet würde, wenn eigentlich die erste If-Bedingung schon greifen würde... Naja, muss ich vielleicht einfach mal messen, was nun schneller ist.
Bei einem Testlauf mit 2000 Zeilen der tabelle sind die Verhältnisse wie folgt:
in 144 Fällen wird eine Datei gefunden, ohne Buchstaben abzuschneiden
in 387 Fällen -''- nach Kürzung
in 1469 Fällen wird gar keine Datei gefunden (-> ist auch i.O. so, es gibt nicht für jeden Eintrag eine...)
Und ein anderes komisches Problem: Alle Bilder sind gleich hoch, nämlich 50 pixel. Excel verkleinert oder vergrössert aber manche der importierten Bilder anscheinend völlig eigenmächtig... Kann man dagegen was tun? Woran liegt das?
Gruss,
Jo

AW: Wäre das schnell?

06.02.2010 12:00:19

Josef

Hallo Jo

wenn du bei meiner Variante den RegExp-Pattern um das $ ergänzt, dann wird die Prüfung nur durchgeführt, wenn die Datei beim ersten Versuch nicht gefunden wird.

Gruß Sepp

AW: VBA: String nach der letzten Ziffer abschneiden

06.02.2010 10:39:08

Ramses

Hallo
http://www.excelformeln.de/formeln.html?welcher=103
Gruss Rainer

AW: VBA: String nach der letzten Ziffer abschneiden

06.02.2010 10:50:03

joerg

Hallo Rainer,
Danke auch Dir, aber ich glaube ich brauch's eher in VBA
gruss,
Jo

so habe ich es verstanden

06.02.2010 10:54:17

Tino

Hallo,
bis zu letzten Zahl im String.

Function StringBis_letzte_Zahl(ByVal strText$) As String
Dim Regex As Object, objMatch As Object
Set Regex = CreateObject("Vbscript.Regexp")
With Regex
    .IgnoreCase = False
    .MultiLine = True
    .Pattern = "\D*\d{1,}"
    .Global = True
    Set objMatch = .Execute(strText)
    
    For Each objMatch In objMatch
          StringBis_letzte_Zahl = StringBis_letzte_Zahl & objMatch
    Next objMatch
End With
Set Regex = Nothing
End Function

Sub Test()
Dim strText$
strText = "ab5cde1fhz25490t"
MsgBox StringBis_letzte_Zahl(strText)
End Sub

Gruß Tino

AW: so habe ich es verstanden

06.02.2010 11:48:31

joerg

Hallo Tino,
Danke, so ähnlich mach ich's jetzt auch, das mit den regular expressions scheint eine gute Lösung zu sein (auch wenn die einen manchmal in den Wahnsinn treiben können...)
Gruss,
Jo

warum so viel VBA-Geschreibsel ?

06.02.2010 11:47:30

Hi Jo,
folgende Arrayformel:
{=LINKS(A1;MAX(ZEILE(1:99)*ISTZAHL(TEIL(A1;ZEILE(1:99);1)*1)))}
ARRAY-Formel {=geschweifte Klammern} nicht eingeben;
Abschluß der Formel mit gleichzeitig Strg / Shift / Enter (statt Enter allein); - das erzeugt sie.
Salut WF

AW: warum so viel VBA-Geschreibsel ?

06.02.2010 11:49:42

joerg

Hallo WF,
VBA deswegen, weil die Strings eben nur manchmal umgewandelt werden müssen, abhängig davon, ob eine Datei mit dem 'unumgewandelten' namen vorhanden ist oder nicht...
Gruss,
Jo

Beliebteste Forumthreads (12 Monate)

VBA: String nach der letzten Ziffer abschneiden

Forumthread: VBA: String nach der letzten Ziffer abschneiden

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA: String nach der letzten Ziffer abschneiden

Forumthread: VBA: String nach der letzten Ziffer abschneiden

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread