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

好的，谢谢Doug Coats叫我去做更大更好的事情。实际上，我在这一方面学到了很多东西。

这会在大约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

如何使此VBA代码-Excel更高效？

2 个答案: