如何在外循环的每次迭代中分配内循环中的每个变量

时间:2014-10-02 00:19:06

标签: excel vba

我在Excel中有两列,每列约有500个字符串。所以A1 - > A500和Y1 - > Y500

我检查单元格Y1中是否有任何字符串 - > Y500出现在单元格A1中,然后是A2,然后是A3等。

我在另一个循环中有一个循环。对于外循环的每次迭代(A1,A2,A3 .... A500),内循环将500个值分配给变量(Y1,Y2,Y3 ... Y500),然后检查一个变量是否包含另一个变量。总计是1/4百万计算。

是否有更精致的方法呢?

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

1 个答案:

答案 0 :(得分: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

范围比较的范围需要一段时间,所以我们所做的是将Range值传输到数组 A列到 arr1 ,列Y到 arr2 。数组比较的数组比后者快。
我们将结果转储到另一个数组( arr3 ),然后将其传递给列T. 至于速度,我的机器中 0.109秒 500 匹配的 500 数据。 HTH。