将Regex放入VBA代码中

时间:2018-07-24 19:24:45

标签: excel vba excel-vba

大约一周前,我问了一个问题,关于删除列中所有单元格的空白并将其复制/粘贴到它旁边的列中。我从某人那里获得了一些帮助来帮助您完成此操作,但是代码并不总是有效。很好,但是我使用代码越多,出现的问题就越多。 VBA代码使用R TRIM作为其修整空白的操作,但这似乎并不总是有效。似乎总是有一个不可删除的怪异空白字符。在提出最初的问题之前,我将代码组合在一起,但是将其部署到其他工作簿上却无法正常工作。

这是我的原始照片

Function simpleCellRegex(myRange As Range) As String

    Dim Regex As New RegExp
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String

    strPattern = "\s+$"

        If strPattern <> "" Then
            strInput = myRange.Value
            strReplace = ""

        With Regex
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With

        If Regex.Test(strInput) Then
            simpleCellRegex = Regex.Replace(strInput, strReplace)
        Else
            simpleCellRegex = strInput
        End If
    End If
End Function

这是我寻求帮助的代码

Option Explicit
Public Sub RemoveEndWhiteSpace()
    Dim arr(), i As Long, myRange As Range
    Set myRange = Selection
    If myRange.Columns.Count > 1 Or myRange Is Nothing Then Exit Sub
    If myRange.Count = 1 Then
        myRange = RTrim$(myRange.Value)
        Exit Sub
    Else
        arr = myRange.Value
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr(i, 1) = RTrim$(arr(i, 1))
        Next i
        myRange.Offset(, 1) = arr
    End If
End Sub

我尝试了多种方法将Regex命令放入工作代码中,但是它总是给我一个错误。我尝试阅读VBA,但没有任何真正帮助我的东西。我之所以希望这样做,是因为我处理大量数据,并且数据看起来非常疯狂。我想清除疯狂的数据,方法是首先删除列的每个单元格中的空白,然后将这些单元格输出到它旁边的列中。我本质上想合并代码,但我不知道如何。

2 个答案:

答案 0 :(得分:1)

仅解决如何合并功能的问题...

未经测试:

Option Explicit
Public Sub RemoveEndWhiteSpace()
    Dim arr(), i As Long, myRange As Range
    Set myRange = Application.Intersect(Selection, ActiveSheet.UsedRange)
    If myRange Is Nothing Then Exit Sub
    If myRange.Columns.Count > 1 Then Exit Sub

    If myRange.Count = 1 Then
        myRange.Offset(0,1).Value = simpleCellRegex(myRange.Value)
    Else
        arr = myRange.Value
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr(i, 1) = simpleCellRegex(arr(i, 1))
        Next i
        myRange.Offset(0, 1).Value = arr
    End If
End Sub


Function simpleCellRegex(v) As String

    Static Regex As RegExp

    'need to create/configure regex?
    If Regex Is Nothing Then
        Set Regex = New Regex
        With Regex
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = "\s+$"
        End With
    End If

    If Regex.Test(strInput) Then
        simpleCellRegex = Regex.Replace(v, "")
    Else
        simpleCellRegex = v
    End If

End Function

答案 1 :(得分:0)

'用替换字符替换模式中未定义的数据范围内的所有数据字符。

Public Sub RegExMatchAndReplace(ByVal Pattern As String, ByVal Data As Range, ByVal Replace As String)

'//////////////////////////////////////////////////////////////////////////

Dim oRegEx As New RegExp
Dim rPtr As Range

'///////////////////////////////////////////////////////////////////////////
For Each rPtr In Data
    With oRegEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = Pattern
        rPtr.Value = oRegEx.Replace(rPtr.Value, Replace)
    End With
Next

End Sub