Question

我有一段代码可以满足我的需求。但是，它运行得太慢了。通过研究，我发现＆＃34;慢慢＆＃34;来自不断访问工作簿，如果我可以从阵列执行操作，它应该显着提高性能速度。我还没有找到任何东西来帮助我完成这件事。所以这就是我得到的。

我的代码在单元格中搜索一个字符串（xlpart），该字符串将包含以逗号分隔的多个数据条目。它会找到该实例和所有其他实例（以及它们在逗号分隔的字符串中的位置），然后将它们重新组合成一个逗号分隔的新字符串。

就像我说的那样，这很有效，但是当我将它应用到4000行时，它会破坏CPU。我甚至尝试加入一些加速＆＃39;我发现的想法。计算和.Screenupdating。我看到的问题是在＆＃34; Set test =＆＃34;线。有没有办法搜索数组，查找字符串的实例，并提取出具体的信息？或者我这样做是错的吗？

Function FindRef(lookupValue As Range, lookupRange As Range, resultsRange As Range) As String
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim OutputName1 As String
Dim OutputName2 As String
Dim r As Long
Dim test As Range
Dim working1() As String
Dim working2() As String

i = 0
For r = 1 To lookupRange.Rows.Count
  Set test = lookupRange.Cells(r, 1).Find(lookupValue.Value, LookIn:=xlValues, lookat:=xlPart)
  If Not test Is Nothing Then
    working1() = Split(lookupRange.Cells(r, 1), ", ")
    For j = LBound(working1) To UBound(working1)
      If working1(j) = CheckValue Then
        working2() = Split(resultsRange.Cells(r, 1), ", ")
        If UBound(working2) > 0 Then
          OutputName1 = working2(j)
        Else
          OutputName1 = resultsRange.Cells(r, 1)
        End If
      End If
    i = i + 1
    If i = 1 Then
      OutputName2 = OutputName1
    Else
      OutputName2 = OutputName2 & ", " & OutputName1
    End If
    OutputName1 = ""
    Next j
  End If
Next
FindRef = OutputName2

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Function

更新的代码：

Function FindRef(lookupValue As Range, lookupRange As Range, resultsRange As Range) As String

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim OutputName1 As String
Dim OutputName2 As String
Dim r As Long
Dim test As Variant
Dim working1() As String
Dim working2() As String
Dim CheckValue As String
Dim data() As Variant
Dim data2() As Variant

CheckValue = lookupValue.Value2
data = lookupRange.Value2
data2 = resultsRange.Value2

i = 0
r = 0
For Each test In data
  r = r + 1
  If test = CheckValue Then
    working1() = Split(data(r, 1), ", ")
    For j = LBound(working1) To UBound(working1)
      If working1(j) = CheckValue Then
        working2() = Split(data2(r, 1), ", ")
        If UBound(working2) > 0 Then
          OutputName1 = working2(j)
        Else
          OutputName1 = data2(r, 1)
        End If
      End If
    i = i + 1
    If i = 1 Then
      OutputName2 = OutputName1
    Else
      OutputName2 = OutputName2 & ", " & OutputName1
    End If
    OutputName1 = ""
    Next j
  End If
Next
FindRef = OutputName2
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Function

Answer 1

使用Range.Find非常慢。

使用变体数组要快得多。查看我的Match vs Find vs Variant Array

在excel vba

1 个答案: