循環內循環 - 如何避免在外循環的每次迭代中分配內循環中的每個變量

Question

我在Excel中有兩列，每列有大約500個字符串。所以A1 - > A500和Y1 - > Y500。 我試圖檢查單元格Y1 - > Y500中是否有任何字符串出現在單元格A1中，然後出現在A2中，然後出現在A3中等。 我對VBA不太好，我已經把自己的方式弄到了我所擁有的位置另一個循環內的循環。對於外部循環（A1，A2，A3 .... A500）的每次迭代，內部循環將500個值分配給變量（Y1，Y2，Y3 ... Y500），然後嘗試查看一個變量是否包含另一個變量。總共有四百五十萬次計算。

我很想得到編程優雅的人的意見，看看是否有更好的方法來做到這一點。我的電腦很爛，這個宏需要aaaaaaaaages。

非常感謝。 康納

Sub search() 
    Dim CForm As String 
    Dim pos As Integer 
    Dim CURL As String 
    Dim Col As Integer 
    Dim Pract As Integer 
    Dim i As Integer 
    Dim j As Integer 
    Dim k As Integer 
    'Count the number of rows in column A 
    Worksheets("Landing (both web & email)>").Select 
    Col = WorksheetFunction.CountA(Range("A:A")) + 1 
    'MsgBox Col 
    'Count the number of rows in column Y 
    Worksheets("Landing (both web & email)>").Select 
    Pract = WorksheetFunction.CountA(Range("y:y")) + 1 
    'MsgBox Pract 
    'For loop, assigning variable CForm to the contents of cells in column A 
    For i = 3 To Col 
     CForm = Cells(i, 1) 
     '2nd For loop, assigning variable CURL to the contents of cells in column Y 
     For j = 3 To Pract 
      CURL = Cells(j, 25) 
      'Check to see if contents of variable CURL appear in variable CForm. 
      pos = InStr(CForm, CURL) 

      If pos > 0 Then 
       Worksheets("Landing (both web & email)>").Range("t" & i).Value = "PractURL" 
       Exit For 
      Else 
       Worksheets("Landing (both web & email)>").Range("t" & i).Value = "" 
      End If 
     Next j 
    Next i 
End Sub 

Answer 1

試試這個：

Dim Col As Long, Pract As Long, j As Long, k As Long 
Dim arr1, arr2, arr3 
With Sheets("Landing (both web & email)>") 
    Col = .Range("A" & .Rows.Count).End(xlUp).Row 
    Pract = .Range("Y" & .Rows.Count).End(xlUp).Row 
    arr1 = Application.Transpose(.Range("A3:A" & Col)) 
    arr2 = Application.Transpose(.Range("Y3:Y" & Pract)) 
    ReDim arr3(LBound(arr1) To UBound(arr2)) 
    For j = LBound(arr1) To UBound(arr1) 
     For k = LBound(arr2) To UBound(arr2) 
      If InStr(arr1(j), arr2(k)) <> 0 Then arr3(j) = "PractURL": Exit For 
     Next k 
    Next j 
    .Range("T3:T" & Col) = Application.Transpose(arr3) 
End With 

範圍範圍比較需要一段時間，所以我們所做的是範圍值傳送到數組。
列A至arr1和列Y至arr2。數組比較比後者快得多。
我們轉儲結果到另一陣列（ARR3）然後將被傳遞給列T.
至於速度，這把0.109秒在我的機器爲數據與匹配。 HTH。