Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1136to1140
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: String nach der letzten Ziffer abschneiden

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
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

Anzeige
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
Anzeige
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

Anzeige
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
Anzeige
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:50:03
joerg
Hallo Rainer,
Danke auch Dir, aber ich glaube ich brauch's eher in VBA
gruss,
Jo
Anzeige
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
Anzeige
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
WF
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
Anzeige

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige