在子程序中调用Myrange函数

时间:2018-07-11 15:47:07

标签: regex excel vba

我组合了一个regex函数,该函数将从一列中删除所有空白,当我在工作表上使用它时,我只需要键入=simplecellregex(),然后在新列中针对所有条目。我这样做的原因是因为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



Sub regex1()

Column.Add
Range("D2").Value = simpleCellRegex(Myrange, String)

End Sub

这是设置,以便每当我获得工作簿时,我都单击要运行该函数的列,然后它运行正则表达式并将其吐到旁边的列中。计划是使它成为一个宏,这样我就可以在excel菜单功能区上添加一个按钮,并使此正则表达式易于运行。

1 个答案:

答案 0 :(得分:0)

编辑:

如果要选择一个范围,然后按一个按钮,请使用以下内容

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 = arr
    End If
End Sub

要输出到其他列:

myRange.Offset(, 1) = arr '<==use offset to put result in a different column e.g. one to the right

与按钮相关联的最后一部分代码的示例运行(宏设置为所有打开的工作簿)

Test


tl; dr;

如果要单击列并尾随空白,请删除类似以下内容的内容。当您选择一列来运行该子项时,它将使用一个工作表事件。子检查在该列中填充了多少个单元格并对其进行处理。

Private Sub Worksheet_SelectionChange将进入您要在其上进行替换的工作表的代码窗格中。

.UsedRange并不总是最可靠的方法。

它调用的子程序将进入标准模块。老实说,我怀疑有更有效的方法可以做到这一点,但我想我会很快进行。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = Columns(1).Cells.Count And Target.Columns.Count = 1 Then
        'MsgBox "running"
        RemoveEndWhiteSpace Intersect(Target, Me.UsedRange)
    End If
End Sub

Public Sub RemoveEndWhiteSpace(ByVal myRange As Range)
    Dim arr(), i As Long
    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 = arr
    End If
End Sub

更可靠的列使用范围是:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = Columns(1).Cells.Count And Target.Columns.Count = 1 Then
       ' MsgBox "running"
        Dim lastRow As Long, myRange As Range
        lastRow = Cells(Rows.Count, Target.Column).End(xlUp).Row
        Set myRange = Range(Cells(1, Target.Column), Cells(lastRow, Target.Column))
        RemoveEndWhiteSpace myRange
    End If
End Sub

相关问题