循环VBA中的调用功能

时间:2018-03-26 09:11:09

标签: vba function loops

对于VBA专业人士来说,我的问题很简单。如果你能帮我理解的话。 我试图调用一个函数,它只保留一个单元格中的上限,并通过循环所有行超过下一列中的结果。请看下面的代码。 谢谢。

private AtomicInteger count = new AtomicInteger();

3 个答案:

答案 0 :(得分:2)

尝试如下所示的内容。注意事项。

1)Extract cap需要一个参数,该参数是您要替换的字符串。我使用了相邻列中的值

2)Option Explicit只应出现在模块顶部一次

3)当您循环行时,使用Long not Integer来避免潜在的溢出

4)与vbNullString的比较比空字符串文字更快""

编辑:

5)请参阅@ Jeeped的评论re静态xRegEx As Object后跟if xregex什么都不是,然后设置xRegEx = CreateObject(" VBSCRIPT.REGEXP"),这在循环中调用时显着提高了性能因为正则表达式对象只能创建一次

Option Explicit
Sub LLOP()

    Dim i As Long
    i = 1

    With ThisWorkbook.Worksheets("Sheet1") 'change as appropriate

    Do While .Cells(i, 10).Value <> vbNullString 'column J
        .Cells(i, 11).Value = ExtractCap(.Cells(i, 10).Text) 'column K
        i = i + 1
    Loop

    End With

End Sub


Public Function ExtractCap(Txt As String) As String

    Application.Volatile
    Dim xRegEx As Object
    Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    xRegEx.Pattern = "[^A-Z]"
    xRegEx.Global = True
    ExtractCap = xRegEx.Replace(Txt, vbNullString)

End Function

答案 1 :(得分:1)

假设您要在11.列中输入自定义=ExtractCap()公式,并且参数为10.列,这是一个可能的解决方案:

Option Explicit

Sub LLOP()

    Dim i As Long: i = 1
    Do While Cells(i, 10).Value <> ""
        Cells(i, 11).Formula = "=ExtractCap(""" & Cells(i, 10) & """)"
        i = i + 1
    Loop
End Sub

Function ExtractCap(Txt As String) As String

    Application.Volatile
    Static xRegEx As Object
    If xRegEx Is Nothing Then Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
    xRegEx.Pattern = "[^A-Z]"
    xRegEx.Global = True
    ExtractCap = xRegEx.Replace(Txt, "")

End Function

.Formula将函数ExtractCap作为公式传递,其参数为Cells(i, 10)

答案 2 :(得分:0)

尝试以下替代代码。你的方法很复杂并使用正则表达式(这很好,但在你的情况下,效果不佳)。

代码:

Option Explicit
Sub LLOP()
Dim i As Integer
i = 1

'indentation! in your original code, you didn't have proper indentation
'I know that VBA editor don't indent code automatically, but it's worth the effort
Do While Cells(i, 10).Value <> ""
    ' invalid syntax!
    ' first, this is kind of multiple assignment (I don't know what are you trying to do)
    ' secondly, you call your function without arguments
    ' Cells(i, 11).Value = Cells(i, 10).Value = ExtractCap
    ' I guess you wanted something like this
    Cells(i, 11).Value = ExtractCap(Cells(i, 10).Value)
    'or using my function:
    Cells(i, 11).Value = SimpleExtractCap(Cells(i, 10).Value)
    i = i + 1
Loop

End Sub

'THIS IS YOUR FUNCTION, which is complicated (unnecessarily)
Function ExtractCap(Txt As String) As String

Application.Volatile
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
xRegEx.Pattern = "[^A-Z]"
xRegEx.Global = True
ExtractCap = xRegEx.Replace(Txt, "")
Set xRegEx = Nothing

End Function

'this is my alternative to your function, which is very simple and basic
Function SimpleExtractCap(Txt As String) As String
SimpleExtractCap = ""
Dim i As Long, char As String
For i = 1 To Len(Txt)
    char = Mid(Txt, i, 1)
    'if we have upper-case letter, then append it to the result
    If isLetter(char) And char = UCase(char) Then
        SimpleExtractCap = SimpleExtractCap & char
    End If
Next
End Function

修改

为了检查给定的字符是否为字母,您需要额外的功能:

Function isLetter(letter As String) As Boolean
Dim upper As String
upper = UCase(letter)
isletter = Asc(upper) > 64 And Asc(upper) < 91
End Function

现在,我将此函数添加到代码中,以检查字符是否为字母。