Question

我有一个小的VBA循环，但要花2-3分钟才能完成，是否知道如何加快/重写它会更快？

范围“替换名称”是“数据”中500个命名区域名称的列表。 for循环搜索与“数据”中的名称匹配的那个，并用“源”中的名称替换一个。这也可以，但是需要一段时间。有没有更快的方法？

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    For Each ID_name In wsSupport.Range("ReplaceNames")
        wsCheck.Range("Data").Replace ID_name, wsSource.Range(ID_name), xlWhole

    Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 1

您可能会从这段有价值的文本中受益：

https://www.microsoft.com/en-us/microsoft-365/blog/2009/03/12/excel-vba-performance-coding-best-practices/

因此，在您的情况下，代码可能看起来像这样：

Dim arrData as Variant, arrSource as Variant, k as long
arrData = wsCheck.Range("Data").value2 'this creates a two-dimensional array with rows on the first and columns on the second index
arrSource = wsSource.Range(...).value2

'loop through rows I suppose
for k = LBound(arrData,1) to UBound(arrData,1)
    if arrData(k, yourColumn) = ... then
        arrData(k, yourColumn) = arrSource(rowhere, columnhere)
    endif   
next k

wscheck.range("Data") = arrData

Answer 2

它现在正在工作！！！如果您发现错误，请告诉我！

Dim arrData As Variant, arrSource As Variant, arrNames As Variant, k As Long

arrData = wsChecklist.Range("Checklist").Value2 'this creates a two-dimensional array with rows on the first and columns on the second index
arrSource = wsSupport.Range("ReplaceNames").Value2
arrNames = wsNia.Range("D1:D1000").Value2

'loop through rows I suppose
For k = LBound(arrData, 1) To UBound(arrData, 1)
For j = LBound(arrData, 2) To UBound(arrData, 2)

'    If UCase(arrData(k, j)) = UCase(arrSource(x, 1)) Then
    If UCase(arrSource(x, 1)) = UCase(arrData(k, j)) Then

    For i = 1 To 1000
            Name1 = wsNia.Cells(i, 2)
            Name2 = wsNia.Cells(i, 3)
            Name = Name1 & "_" & Name2

        If UCase(arrData(k, j)) = UCase(Name) Then
                arrData(k, j) = arrNames(i, 1)
                x = x + 1
                k = 1
                j = 1
                i = 1

            Exit For
        End If


Next i

    End If

If k > 2900 And x < 265 Then
    x = x + 1
    j = 1
    k = 1
End If

Next j
Next k

wsChecklist.Range("Checklist").Value2 = arrData

加快VBA替换循环的速度或使用其他方法？

2 个答案: