Question

我写了一些代码需要花费太多时间来计算。

它＆＃34;画笔＆＃34;特定列中的行，从工作表（Plan1，具有11,617行，在第2行开始数据），查找单元格的值，存储此值，搜索第二个工作表中特定列中的每一行（Plan2），158,715行，也在第2行开始数据）并验证遇到的值是否与搜索到的值匹配。如果为true，则存储该值，然后将其分配给上一个工作表（Plan1）中的未使用单元格，在同一行但在新列中。它可以工作，但由于行数很大，因此在Plan1中每个列需要大约1小时。

有一次，我尝试使用VLOOKUP，花费的时间非常少（大约5分钟），但是数据被奇怪地破坏了，所以我开始使用VBA编程来获得更高的数据准确性。我抬头看着this question，但我的问题比答案的解释更具体。我翻译了代码以便更好地理解，因此如果您发现语法错误，请不要担心;这段代码在翻译之前就已经开始了。

最后，这是我的代码。

Sub AddAddress()

    Dim Plan1, Plan2 As Worksheet
    Dim FirstRow As Long
    Dim LastRow As Long
    Dim CurrentRow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim SoughtId, EncounteredId, Address As String
    Dim SuccessCounter As Integer
    Dim StartTime, EndTime, ElapsedTime As Date

    StartTime = Time()

    Set Plan1 = Application.Worksheets("Plan1")
    Set Plan2 = Application.Worksheets("Plan2")

    'Define calculation mode
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Use Plan1
    With Plan1

        'Select this worksheet
        .Select

        'Memory optimization
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView
        .DisplayPageBreaks = False

        'First and last rows' loop
        FirstRow = .UsedRange.Cells(1).Row
        LastRow = .UsedRange.End(xlDown).Row

        'Loop execution
        For CurrentRow = LastRow To FirstRow Step -1

            'Check Id value in A column
            With .Cells(CurrentRow, "A")

                'Store SoughtId
                SoughtId = .Value

                'Search Address via Id on Plan2
                With Plan2

                    .Select
                    Dim ActiveCell As String

                    With .Range("D:D")

                        'Search Id
                        If (SoughtId = .Find(SoughtId)) Then

                            EncounteredId = SoughtId

                        End If

                        ActiveCell = .Find(SoughtId).Address

                    End With

                    'Define/store Address
                    With .Range(ActiveCell)

                        'Being in current column, go to the column that
                        'contains the wanted value if this value is not empty
                        If .Offset(0, 9).Value <> "" Then

                            Address = .Offset(0, 9).Value

                        End If

                    End With

                End With

                Plan1.Select

                'Append Address obtained value in corresponding row's cell
                'and increment SuccessCounter
                With .Offset(0, 15)

                    .Value = Address

                End With

            SuccessCounter = SuccessCounter + 1

            End With

        Next CurrentRow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

    EndTime = Time()
    ElapsedTime = EndTime - StartTime

    MsgBox "Operation finished!" & vbNewLine & vbNewLine & "Added addresses: " & SuccessCounter & vbNewLine & "Time elapsed: " & ElapsedTime

End Sub

Answer 1

我不会尝试使用.select方法在两个工作表之间来回切换。而是尝试直接在工作表上引用这些值而无需切换。它看起来像Worksheets("Plan1").Range("Range You Want")。也尝试不使用ActiveCell，因为这会导致excel更改它选择了几十万次的单元格，这很慢。

希望这有帮助。

Answer 2

您正在使用With ... End With块，但通过在块中添加.Select命令来挫败其目的。
您.Find一次查看某些内容是否存在，然后再次.Find获取值
ActiveCell ，地址等是保留字，不应重新定义为变量。
Dim Plan1, Plan2 As Worksheet之类的声明将 Plan1 创建为变体而非工作表类型。

看看这是否加快了速度。

Sub Addaddr()
    Dim Plan1 As Worksheet, Plan2 As Worksheet
    Dim rw As Long, FirstRow As Long, LastRow As Long
    Dim CalcMode As Long
    Dim SoughtId, addr As String
    Dim SuccessCounter As Long
    Dim StartTime As Date, EndTime As Date, ElapsedTime As Date

    StartTime = Time()

    Set Plan1 = ActiveWorkbook.Worksheets("Plan1")
    Set Plan2 = ActiveWorkbook.Worksheets("Plan2")

    'Define calculation mode
    With Application
        .ScreenUpdating = False
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With

    With Plan1
        'First and last rows' loop
        FirstRow = 1
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row

        For rw = LastRow To FirstRow Step -1

            'Store SoughtId
            SoughtId = .Cells(rw, "A").Value

            'Search addr via Id on Plan2
            addr = vbNullString
            With Plan2
                If CBool(Application.CountIf(.Range("D:D"), SoughtId)) Then
                    addr = .Cells(Application.Match(SoughtId, .Range("D:D"), 0), "M").Value
                End If
            End With
            If CBool(Len(addr)) Then
                .Cells(rw, "O") = addr
                SuccessCounter = SuccessCounter + 1
            End If

        Next rw

    End With

    With Application
        .EnableEvents = True
        .Calculation = CalcMode
        .ScreenUpdating = True
    End With

    EndTime = Time()
    ElapsedTime = EndTime - StartTime

    MsgBox "Operation finished!" & vbNewLine & vbNewLine & "Added addres: " & SuccessCounter & vbNewLine & "Time elapsed: " & ElapsedTime

End Sub

我已使用工作表COUNTIF function来确定是否存在交叉引用值，然后使用MATCH function来检索行号。这不是最有效但可能比没有错误控制的两个.Find操作更好。

如前所述，这将真正受益于基于内存的处理，如字典或变体数组。看一下定时速度测试here。

Answer 3

最快的方法是使用带有Excel内置功能的公式。我将此公式放入工作表＆＃34; Plan1＆＃34;：

的第O列

=IF(ISERROR(MATCH($A1;Plan2!$D:$D;0));"";OFFSET(Plan2!$D$1;MATCH($A1;Plan2!$D:$D;0)-1;9))

这是它的工作原理：

MATCH($A1;Plan2!$D:$D;0))
如果Plan1！$ A1中的值在Plan2！$ D：$ D范围内找到，则返回行号，否则返回#NV错误。
如果未找到，则公式返回空字符串
如果找到，则返回相同行号的值，但偏移量为9的列（＆＃34; D＆＃34; - ＆gt;＆＃34; M＆＃34;）。

确实有效。我用长度为600的Plan1和长度为15.0000的Plan2进行了测试。在我的电脑上重新计算大约需要1秒钟。由Jeedped提供的VBA子项确实需要大约相同的时间。

当然，重复MATCH()函数会耗费我们的运行时间。你放的好了 MATCH($A1;Plan2!$D:$D;0)
进入一个未使用的离屏列（例如，＆＃34; X＆＃34;）并使用
=IF(ISERROR($X1);"";OFFSET(Plan2!$D$1;$X1-1;9))
在目标列中。（示例公式都进入第1行）。

在工作表

3 个答案: