Text-String bereinigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
Leerzeichen zwischen den Buchstaben M, m oder U und einer Zahl sollen gelöscht werden.
Das passt aber nicht zu deinem ersten Beispiel:
"Text Text 3 000 000 IU Text" korrigiert "Text Text 3 000 000IU text"
Schau mal ob dich dies weiter bringt:
Tabelle1

	A	B
1	"Text Text 3 000 000 IU Text	"Text Text 3 000 000IU Text
2	"Text Text 20 ma Text	"Text Text 20ma Text
3	"Text Text 30 MA text	"Text Text 30MA text
4	"Text Text 0.5 MA text	"Text Text 0.5MA text
5	abc	abc

Formeln der Tabelle

Zelle	Formel
B1	=machs(A1)
B2	=machs(A2)
B3	=machs(A3)
B4	=machs(A4)
B5	=machs(A5)

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Das ist der Code:

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

Option Explicit

Function machs(zelle) As String
    Dim Regex As Object
    Dim objMatch As Object
    Set Regex = CreateObject("VbScript.Regexp")
    With Regex
        .Pattern = "[0-9] (?=[a-zäöüß])"
        .ignorecase = True
        .Global = True
        If .test(zelle) = True Then
            For Each objMatch In .Execute(zelle)
                machs = .Replace(zelle, Left(objMatch, 1))
            Next
            Else:
            machs = zelle
        End If
    End With
End Function

ransi

Hallo Peter,
Schau mal hier:

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bereich As Range
    Dim objZelle As Range
    Dim bolEvents As Boolean
    Set Bereich = Intersect(Target, Range("G4:G" & Rows.Count))
    If Bereich Is Nothing Then Exit Sub 'Auf Bereich G4:G ganz unten
    On Error GoTo Errorhandler
    bolEvents = Application.EnableEvents
    Application.EnableEvents = False 'Ereignissmakros ausschalten
    For Each objZelle In Bereich
        objZelle = machs(objZelle)
    Next
    Errorhandler:
    Application.EnableEvents = bolEvents 'Ereignissmakros auf alte Einstellunb setzen
End Sub

Function machs(Zelle)
    Dim Regex As Object
    Dim objMatch As Object
    Set Regex = CreateObject("VbScript.Regexp")
    With Regex
        .Pattern = "[0-9] (?=[a-zäöüß])" 'Findet ein einzelnes Leerzeichen zwischen Zahl und Buchstabe
        .ignorecase = True
        .Global = True
        If .test(Zelle) = True Then
            For Each objMatch In .Execute(Zelle)
                machs = .Replace(Zelle, Left(objMatch, 1))
            Next
            Else:
            machs = Zelle
        End If
    End With
End Function

Der Code gehört nicht in ein Standardmodul sondern in das Klassenmodul der Tabelle MA.
Userbild

ransi

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread