Как сделать этот код VBA - Excel более эффективным?

Question

С уважением; У меня есть следующий код, и я хочу сделать его более эффективным, так как есть 1 000 000 записей для анализа. Большое спасибо, прошу прощения за мое английское горе.

Sub test()
Sub test()
    Dim value1 As Worksheet, value2 As Worksheet
    Dim col1 As Long, col2 As Long
    Set value1 = Worksheets(2)
    Set value2 = Worksheets(2)
    For col1 = 2 To value1.Range("A2").End(xlDown).Row
        For col2 = 2 To value2.Range("B2").End(xlDown).Row
            If value1.Cells(col1, 1).Value = value2.Cells(col2, 2).Value _
                And value1.Cells(col1, 1).Value > 0 Then
                    value1.Cells(col1, 1).Interior.Color = vbYellow
            End If
        Next
    Next
End Sub

Answer 1

Мне стало скучно и я кое-что сделал для тебя.

Private Sub utqwdelkdfjsvd()
    Dim rng As String
    Dim i As Long, j As Long
    Dim pickup As Variant
    pickup = ThisWorkbook.Worksheets("yoursheetname").usedrange
    For i = LBound(pickup, 1) To UBound(pickup, 1)
        For j = LBound(pickup, 1) To UBound(pickup, 1)
            If pickup(i, 1) = pickup(j, 2) And pickup(i, 1) > 0 Then
                If i = 1 Then
                    rng = "a" & i
                Else
                    rng = rng & ", a" & i
                End If
            End If
        Next j
    Next i
    ThisWorkbook.Worksheets("Sheet1").Range(rng).Interior.ColorIndex = 4
End Sub

Answer 2

Хорошо, спасибо, Даг Коутс, за то, что призвал меня к большему и лучшему Я сам многому научился на этом.

Это окрасит весь список примерно за 10 секунд.

Ключевые особенности этого метода:

Извлечь данные в память. Сортировка списков. Заказанные данные позволят вам Разберите списки с помощью двух итераторов, которые помогут вам избежать ненужных операций чтения. попытаться связать «раскрашивание» клеток. Это медленная операция, поэтому мы сводим к минимуму количество необходимых операций. Поэтому я надеюсь, что следующее имеет смысл с учетом этого обзора.

Sub Yellowizer()
    Debug.Print Now
    ' all this garbge with the extra worksheet is because I was too lazy to hunt up a
    ' decent sort for arrays.  You can improve this if you want.
    Set SourceSheet = ActiveSheet
    Set TempSheet = Worksheets.Add

    'declare some working variables
    Dim rngString As String: '<--- dont use command separators
    rngString = ""
    Dim checkList As Variant
    Dim readList As Variant

    ' Get a sorted array of the values we are going to check against (column "b")
    With TempSheet.Range("A:A")
        .Value = SourceSheet.Range("B:B").Value
        .Sort Key1:=TempSheet.Range("A1"), Order1:=xlAscending, Header:=xlNo
        .RemoveDuplicates 1, xlNo
    End With

    checkList = TempSheet.Range("A1", TempSheet.Range("A1").End(xlDown))
    ' Get a sorted array of the values we are going to test (column "a").  Also
    ' bring a reference of where they came from so we can go color the proper field
    readList = SourceSheet.Range("A:B").Value

    For i = 1 To UBound(readList)
        readList(i, 2) = i
    Next i

    With TempSheet.Range("A:B")
        .Value = readList
        .Sort Key1:=TempSheet.Range("A1"), Order1:=xlAscending, Header:=xlNo
    End With

    readList = TempSheet.Range("A:B")
    ' get rid of this working sheet
    TempSheet.Delete
    SourceSheet.Activate
    ' Declare some iterators for reading our arrays
    Dim checkListIterator, readListIterator, checkListMovingLowerBound As Double
    checkListIterator = 1
    readListIterator = 1
    checkListMovingLowerBound = 1

    ' Iterate over the Read list and the Check list.  Take advantage of the
    ' sorted arrays to skip as many reads as possible by advancing the
    ' moving lower bound or by escaping early when matches aren't possible.
    For readListIterator = 1 To UBound(readList)
        For checkListIterator = checkListMovingLowerBound To UBound(checkList)
            If checkList(checkListIterator, 1) < readList(readListIterator, 1) Then
                checkListMovingLowerBound = checkListMovingLowerBound + 1
            Else
                If checkList(checkListIterator, 1) = readList(readListIterator, 1) Then
                    rngString = rngString & "a" & readList(readListIterator, 2) & ", "
                    If Len(rngString) > 180 Then
                        rngString = Left(rngString, Len(rngString) - 2)
                        SourceSheet.Range(rngString).Interior.Color = vbYellow
                        rngString = ""
                    End If
                End If
                'set iterator to finsh this checkList scan and move to next read item
                checkListIterator = UBound(checkList)
            End If
        Next checkListIterator
    Next readListIterator

    rngString = Left(rngString, Len(rngString) - 2)
    SourceSheet.Range(rngString).Interior.Color = vbYellow
    Debug.Print Now
End Sub