对于VBA专业人士来说,我的问题很简单。如果你能帮我理解的话。 我试图调用一个函数,它只保留一个单元格中的上限,并通过循环所有行超过下一列中的结果。请看下面的代码。 谢谢。
private AtomicInteger count = new AtomicInteger();
答案 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
现在,我将此函数添加到代码中,以检查字符是否为字母。