使用 range 方法为整列调用用户定义的函数



我正在尝试在整个列上使用以下函数。可以使用范围方法吗?这样它会很快而不是循环,我猜。

Function cleanString(text As String) As String
Dim output As String
Dim c 'since char type does not exist in vba, we have to use variant type.
For i = 1 To Len(text)
c = Mid(text, i, 1) 'Select the character at the i position
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c 'add the character to your output.
Else
output = output & " " 'add the replacement character (space) to your output
End If
Next
cleanString = output 
End Function

私人子cmdGetItem_Click((

Dim xlwb As Excel.Workbook
Dim xlsh As Excel.Worksheet
Dim xlshdb As Excel.Worksheet
Dim rng, rngdb As Range
Dim totalRows As Long
Dim r As Integer
Dim var As Variant
Set xlwb = Workbooks.Open(strFile)
Set xlsh = xlwb.Worksheets("Main")
Set xlshdb = xlwb.Worksheets("DB")
Set rng = xlsh.Range("C2:C" & LRow)
Set rngdb = xlshdb.Range("C:C").CurrentRegion
totalRows = rngdb.Rows.Count
Set rngdb = xlshdb.Range("C1:C" & totalRows)
xlsh.Range("M2:M" & LRow).Formula = "=cleanString(C2)"
xlsh.Range("C2:C" & LRow).Formula = xlsh.Range("M1:M" & LRow).Value
xlshdb.Range("M1:M" & totalRows).Formula = "=cleanString(C1)"
xlshdb.Range("C1:C" & totalRows).Formula = xlshdb.Range("M1:M" & LRow).Value
xlshdb.Range("D:D").Copy xlshdb.Range("N:N")

Set rng = Nothing
Set rng = xlsh.Range("M2:M" & LRow)
xlsh.Range("B2:B" & LRow) = Excel.WorksheetFunction.VLookup(rng.Value, xlshdb.Range("M:N"), 2, False)
UserForm1.lstInvoiceItems.Refresh
xlwb.Close True
Set xlwb = Nothing: Set xlsh = Nothing: Set xlshdb = Nothing: Set rng = Nothing: Set rngdb = Nothing

结束子

您可以使用搜索和替换或字典之类的东西,但为了快速解决,我会使用帮助程序列并使用 Excels 本机增量功能来对抗您的 UDF。

这会将现有函数用作 Excel 函数到帮助程序列中,以便递增,然后复制到原始位置,最后删除帮助程序列中的数据:

Sub Main()
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("B1:B" & lr).Formula = "=cleanString(A1)"
Range("A1:A" & lr).Formula = Range("B1:B" & lr).Value
Range("B1:B" & lr).ClearContents
End Sub

但是,有几个警告:

确保将对列 B 的所有引用更改为没有您不关心的数据的列。

将对"A"的所有引用更改为要清理的列,包括设置 lr 的开头(最后一行(

最新更新