vba - Excel 6 列比较

Question

我正在尝试比较One Sheet and 3 columns in the其他工作表中的 6 列、3 列。

谢谢

标签： vbaexcelexcel-formula

Answer 1

这需要一些重构。这将重复订单中重复项目的结果。它使用字典来保存商店使用项目作为键的总和。

Option Explicit
Public Sub GetInventoryForListedItems()
    Application.ScreenUpdating = False
    Dim wb As Workbook, orders As Worksheet, inventory As Worksheet

    Set wb = ThisWorkbook
    Set orders = wb.Worksheets("Orders")
    Set inventory = wb.Worksheets("Inventory")

    Dim store1Dict As Object, store2Dict As Object, store3Dict As Object, store4Dict As Object, orderList As Object
    Set store1Dict = CreateObject("Scripting.Dictionary")
    Set store2Dict = CreateObject("Scripting.Dictionary")
    Set store3Dict = CreateObject("Scripting.Dictionary")
    Set store4Dict = CreateObject("Scripting.Dictionary")
    Set store5Dict = CreateObject("Scripting.Dictionary")
    Set store6Dict = CreateObject("Scripting.Dictionary")
    Set orderList = CreateObject("Scripting.Dictionary")

    Dim ordersArray(), inventoryArray(), lastRowOrders As Long, lastRowInventory As Long, i As Long, ordersData As Range

    With orders
        lastRowOrders = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set ordersData = .Range("A2:A" & lastRowOrders)
        Select Case lastRowOrders
        Case Is < 2
            Exit Sub
        Case 2
            ReDim ordersArray(1, 1): ordersArray(1, 1) = ordersData.Value
        Case Else
            ordersArray = ordersData.Value
        End Select

        For i = LBound(ordersArray, 1) To UBound(ordersArray, 1) 'dictionary of the orders to then search for in inventory
            orderList(ordersArray(i, 1)) = vbNullString
        Next
    End With
    With inventory
        lastRowInventory = .Cells(.Rows.Count, "A").End(xlUp).Row
        Select Case lastRowInventory
        Case Is < 2
            Exit Sub
        Case 2
            ReDim inventoryArray(1, 3)
            inventoryArray(1, 1) = .Range("A2").Value
            inventoryArray(1, 2) = .Range("B2").Value
            inventoryArray(1, 3) = .Range("C2").Value
        Case Else
            inventoryArray = .Range("A2:C" & lastRowInventory).Value
        End Select

        For i = LBound(inventoryArray, 1) To UBound(inventoryArray, 1) 'check if inventory item in orders dictionary
            If orderList.Exists(inventoryArray(i, 1)) And IsNumeric(inventoryArray(i, 2)) Then
                Select Case inventoryArray(i, 3) ' add to dictionaries based on store
                Case 1
                    store1Dict(inventoryArray(i, 1)) = store1Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                Case 2
                    store2Dict(inventoryArray(i, 1)) = store2Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                Case 3
                    store3Dict(inventoryArray(i, 1)) = store3Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                Case 4
                    store4Dict(inventoryArray(i, 1)) = store4Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                Case 5
                    store5Dict(inventoryArray(i, 1)) = store5Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                Case 6
                    store6Dict(inventoryArray(i, 1)) = store6Dict(inventoryArray(i, 1)) + inventoryArray(i, 2)
                End Select
            End If
        Next
    End With
    With orders
        For i = LBound(ordersArray, 1) To UBound(ordersArray, 1)
            On Error Resume Next
            .Cells(i + 1, 11) = store1Dict(ordersArray(i, 1))
            .Cells(i + 1, 12) = store2Dict(ordersArray(i, 1))
            .Cells(i + 1, 13) = store3Dict(ordersArray(i, 1))
            .Cells(i + 1, 14) = store4Dict(ordersArray(i, 1))
            .Cells(i + 1, 15) = store5Dict(ordersArray(i, 1))
            .Cells(i + 1, 16) = store6Dict(ordersArray(i, 1))
            On Error GoTo 0
        Next
        .Range("E2:J" & lastRowOrders).Replace What:="", Replacement:="Not found"
    End With
    Application.ScreenUpdating = True
End Sub