Question

以下代码适用于未过滤的数据，第一个工作簿的范围为100到8000行，第二个工作簿包含500到28000行。我尝试比较两个工作簿并将值更新为Workbook2。该代码寻找每一行的匹配值，即使一天运行也要花费大量时间。 8000 x 28000个订单项。

我正试图将其隐藏起来，以便将D列中用户名唯一值的过滤数据写入最后一列

过滤工作簿1和工作簿2并比较每一行并更新值。截至现在，我们正在两个工作簿之间进行数据的vlookup，并复制并粘贴匹配的数据，这些数据不是连续的。因为存在不对工作簿进行排序的限制2。我确保按报表管理器的列对workbook1进行排序。

Public Function UpdateData(sFile1 As String, sFile2 As String) As Boolean
Dim col1 As Integer
Dim iCol, iname, ipos, idate, iUsername, iPSId, iUserid, iHint As Integer
Dim iRUCost, iService As Integer
Dim sName As String
Dim sPos As String
Dim sDate As String
iPSId = Sheet1.Range("SAPID1").Value
iRUCost = Sheet1.Range("rucost").Value
iService = Sheet1.Range("service").Value
col1 = Sheet1.Range("access1").Value
iname = Sheet1.Range("name1").Value
ipos = Sheet1.Range("position1").Value
idate = Sheet1.Range("date1").Value
iHint = Sheet1.Range("hint1").Value
iUsername = Sheet1.Range("username1").Value
iUserid = Sheet1.Range("userid1").Value

Set objCWk1 = Application.Workbooks.Open(sFile1)
Set objCWk2 = Application.Workbooks.Open(sFile2)

iHeaderRow = Sheet1.Range("header1").Value

For i = 1 To objCWk1.ActiveSheet.Cells(1, 1).End(xlDown).Row

For j = iHeaderRow To objCWk2.ActiveSheet.Cells(iHeaderRow, 1).End(xlDown).Row
'If iRUCost > 0 And iService > 0 Then
    If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iRUCost).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iRUCost).Value) And _
                                                 UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iService).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iService).Value) Then

        GoTo Action

    End If
    ElseIf iRUCost > 0 And iService = 0 Then
    If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iRUCost).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iRUCost).Value) Then

        GoTo Action

    End If
    ElseIf iRUCost = 0 And iService > 0 Then
    If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iService).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iService).Value) Then

        GoTo Action

    End If
    ElseIf iRUCost = 0 And iService = 0 Then
    If UCase(objCWk1.ActiveSheet.Cells(i, iUsername).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUsername).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iPSId).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iPSId).Value) And _
                                                UCase(objCWk1.ActiveSheet.Cells(i, iUserid).Value) = UCase(objCWk2.ActiveSheet.Cells(j, iUserid).Value) Then

        GoTo Action

    End If
    End If
    GoTo ThisAction
    Action:
    objCWk2.ActiveSheet.Cells(j, col1).Value = objCWk1.ActiveSheet.Cells(i, col1).Value
        objCWk2.ActiveSheet.Cells(j, col1 + 1).Value = objCWk1.ActiveSheet.Cells(i, col1 + 1).Value
        objCWk2.ActiveSheet.Cells(j, col1 + 2).Value = objCWk1.ActiveSheet.Cells(i, col1 + 2).Value

        objCWk2.ActiveSheet.Cells(j, iname).Value = objCWk1.ActiveSheet.Cells(i, iname).Value
        objCWk2.ActiveSheet.Cells(j, ipos).Value = objCWk1.ActiveSheet.Cells(i, ipos).Value
        objCWk2.ActiveSheet.Cells(j, idate).Value = objCWk1.ActiveSheet.Cells(i, idate).Value
        objCWk2.ActiveSheet.Cells(j, iHint).Value = objCWk1.ActiveSheet.Cells(i, iHint).Value
    ThisAction:
    Next j
    Next i
    objCWk2.Save
    objCWk1.Close
    objCWk2.Close
    Set objCWk1 = Nothing
    Set objCWk2 = Nothing

End Function

使用过滤的行循环并比较两个工作簿

0 个答案: