Code abändern

Sub Nur_Text() Dim Regex As Object Dim meAr(), strInhalt$ Dim nCount&, lngMaxRow& Dim oMatch As Object With Sheets("Tabelle1") 'Tabelle anpassen lngMaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row If lngMaxRow = 1 Then meAr = .Range("A1", .Cells(lngMaxRow, 1)).Resize(, 2).Value2 ReDim Preserve meAr(1 To UBound(meAr), 1 To 1) Else meAr = .Range("A1", .Cells(lngMaxRow, 1)).Value2 End If Set Regex = CreateObject("Vbscript.Regexp") With Regex .MultiLine = True .Global = True For nCount = 1 To UBound(meAr) .Pattern = "[.!?]" Set oMatch = .Execute(meAr(nCount, 1)) For Each oMatch In oMatch meAr(nCount, 1) = Left$(meAr(nCount, 1), oMatch.FirstIndex + 1) Exit For Next oMatch .Pattern = "[^A-Za-z .!?,äüöß]" meAr(nCount, 1) = .Replace(meAr(nCount, 1), " ") .Pattern = " +" meAr(nCount, 1) = .Replace(meAr(nCount, 1), " ") .Pattern = "^ | $" meAr(nCount, 1) = .Replace(meAr(nCount, 1), "") Next nCount End With .Range("A1").Resize(UBound(meAr)) = meAr End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
müsste funktionieren.
Hättest aber auch im alten Beitrag bleiben können.

Sub Nur_Text()
Dim Regex As Object
Dim meAr(), strInhalt$
Dim nCount&, lngMaxRow&, lngCol&
Dim oMatch As Object
Dim oWS As Worksheet

Set oWS = Sheets("Tabelle1") 'Tabelle anpassen 


    Set Regex = CreateObject("Vbscript.Regexp")
    
    With Regex
      .MultiLine = True
      .Global = True
    
        For lngCol = 1 To 10 'Spalte A bis J durchlaufen 
            
            With oWS
                 lngMaxRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
                 
                 If lngMaxRow = 1 Then
                     meAr = .Range(.Cells(1, lngCol), .Cells(lngMaxRow, lngCol)).Resize(, 2).Value2
                     Redim Preserve meAr(1 To Ubound(meAr), 1 To 1)
                 Else
                     meAr = .Range(.Cells(1, lngCol), .Cells(lngMaxRow, lngCol)).Value2
                 End If
            End With 'End oWS 
            
            
            For nCount = 1 To Ubound(meAr)
                
                .Pattern = "[.!?]"
                Set oMatch = .Execute(meAr(nCount, 1))
                For Each oMatch In oMatch
                    meAr(nCount, 1) = Left$(meAr(nCount, 1), oMatch.FirstIndex + 1)
                    Exit For
                Next oMatch
                
                .Pattern = "[^A-Za-z .!?,äüöß]"
                meAr(nCount, 1) = .Replace(meAr(nCount, 1), " ")
                
                .Pattern = " +"
                meAr(nCount, 1) = .Replace(meAr(nCount, 1), " ")
                
                .Pattern = "^ | $"
                meAr(nCount, 1) = .Replace(meAr(nCount, 1), "")
            
            Next nCount
            
            oWS.Cells(1, lngCol).Resize(Ubound(meAr)) = meAr
            
            Erase meAr
        Next lngCol
    
    End With 'End Regex 


End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread