是否有比循环更好的替代方案来减少处理时间?

时间:2014-03-14 14:40:58

标签: excel vba loops

我在待处理数据列表中循环访问values,然后在其中任何值为新值时更新主列表。待处理列表通常包含100-200 rows个数据,每个row将有大约10个variables,需要确保在主列表中更新。主列表大约是10,000 rows

我编写的代码将loopeach row待处理列表,将values分配给variables,然后在主列表上执行find寻找匹配的记录,然后相应地更新它。我的代码工作正常,完全符合我的要求,但处理时间大约是4分钟,比使用它的人愿意不抱怨的时间长3分50秒。

是否有可用于帮助减少处理时间的替代编码?

我的代码非常长,所以我不打算将它全部粘贴在这里,而是粘贴剪辑 - 它可以让你知道我目前在做什么:

Application.Screenupdating = False
Applicaiton.Enableevents = False
Application.Calculation = xlCalculationManual

PendingBRow = ThisWorkbook.Sheets("PendingLog").Range("A65000").End(xlUp).Row
MasterBRow = ThisWorkbook.Sheets("MasterLog").Range("A65000").End(xlUp).Row

For D = 2 To PendingBRow
With ThisWorkbook.Sheets("PendingLog").Range("A" & D)
PendingRecordNumber = .Value
PendingIR = .offset(0, 5).Value
PendingVal = .offset(0, 6).Value
End With

With ThisWorkbook.Sheets("MasterLog").Range("B2:B" & MasterBRow)
Set c = .Find(PendingRecordNumber, LookIn:=xlValues)
If Not c Is Nothing Then
        firstAddress = c.Address
        Do
DaysSinceLastWorkedStatic = c.offset(0, 22).Value


MasterIRValue = c.offset(0, 16).Value
            If PendingIR <> 0 Then
            If PendingIR <> MasterIRValue Then
            c.offset(0, 16).Value = PendingIR
            DaysSinceLastWorkedStatic = 0
            c.offset(0, 22).Value = DateVal
            End If
            End If

            c.offset(0, 24).Value = POorLA
            c.offset(0, 25).Value = FinalizedFlag
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress ' in rare cases a record number could be duplicated on the master list.  


end if
end with

ThisWorkbook.Sheets("PendingLog").Range("A" & D).offset(0, 15).Value = DaysSinceLastWorkedStatic
Next D

我考虑过的另一个选择是按记录号过滤主列表并仅更新可见行,然后对未决列表中的每个记录号进行不过滤。我还没有测试过这种方法。

这种方法能比我的方法更好吗?

1 个答案:

答案 0 :(得分:3)

所以我不知道这是否是一个答案,但我认为这至少可以让你看看另一种类型的查找/更新代码。

这用于更新人们计划工作的时间

在这个例子中,我有一个名字B和时间的行A.我将更新后的名称和时间粘贴在行H和I中。有时它的全部98次有时只有5次,这个程序查看列表找到名称并从I获取时间并将其写入B中相应的时间。 / p>

Option Explicit
Sub Update_Holiday()

Dim ws          As Worksheet
Dim SrcRng      As Range
Dim schRng      As Range
Dim c           As Range
Dim search      As Range


Set ws = ThisWorkbook.Sheets(3)
Set SrcRng = ws.Range("H2:H98")
Set schRng = ws.Range("A2:A98")


For Each c In SrcRng
    Set search = schRng.Find(c.Value, LookIn:=xlValues, SearchDirection:=xlNext)
    If Not search Is Nothing Then
        c.Offset(, 1).Copy search.Offset(, 1)

    End If
Next c

End Sub