简体   繁体   中英

Find string within an array optimization for excel vba

I have a piece of code that works for what I need. However, it runs too slow. Through research I found that the "slowness" is coming from constantly accessing the workbook and if I could do the operations from an array it should significantly improve performance speed. I haven't been able to find anything to specifically help me through this. So here is what I got.

My code searches for a string (xlpart) within a cell which will have multiple data entries separated by commas. It'll find that instance and all other instances (and their position within the comma delimited string) and then recombine them into a new string that is comma delimited.

So like I said, this works, but when I apply it to 4000 rows it crushes the CPU. I even tried adding in some 'speeding up' ideas I found like .Calculation and .Screenupdating. The problem I see is in the "Set test =" line. Is there a way to search through an array, find instances of a string, and extract specific information out? Or am I doing this all wrong?

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

Updated code:

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

Using Range.Find is very slow.

Its much faster to use variant arrays. See my Match vs Find vs Variant Array

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM