Excel VBA обновляет значение инвентаря до другой ошибки листа

Question

У меня есть 2 листа в моем Excel, "Sheet1" для получения квитанции и "Sheet2" для инвентарного запаса.то, что я хочу сделать, это когда пользователь вставляет название продукта в строки A16 и A17, количество товара из «Лист2» ​​с тем же именем обновляется.Код, который я делаю, может обновлять количественную единицу из ячейки A16, но количественная единица ячейки A17 не обновляется (показано на рисунке).Кто-нибудь знает, что не так с моим кодом?На изображении 2 предмета: сыр Cheetos и горячий Cheetos.когда я делаю квитанцию ​​только сыр Cheetos количество уменьшается изображение

Вот код

Sub printInvoice()
Dim rng1, rng2, cell1, cell2 As Range
Dim rConstants As Range
Dim lastRow1 As Long
lastRow1 = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Set rng1 = Worksheets("Sheet1").Range("A16:A17" & lastRow1)

Dim lastRow2 As Long
lastRow2 = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Set rng2 = Worksheets("Sheet2").Range("B2:B" & lastRow2)

Dim lr4 As Long
lr4 = Sheets("DaftarPenjualan").Range("A" & Rows.Count).End(xlUp).Row + 1

For Each cell1 In rng1
    If IsEmpty(cell1.Value) Then Exit For
        For Each cell2 In rng2
            If IsEmpty(cell2.Value) Then Exit For
                If cell1 = cell2 Then

                        cell2.Offset(0, 2) = cell2.Offset(0, 2) - cell1.Offset(0, 1)
                        Sheet1.PrintOut
                        Sheets("DaftarPenjualan").Range("A" & lr4).Value = Sheet1.Range("B11")
                        Sheets("DaftarPenjualan").Range("B" & lr4).Value = Sheet1.Range("B10")
                        Sheets("DaftarPenjualan").Range("C" & lr4).Value = Sheet1.Range("A16")
                        Sheets("DaftarPenjualan").Range("D" & lr4).Value = Sheet1.Range("C16")
                        Sheets("DaftarPenjualan").Range("F" & lr4).Value = Sheet1.Range("D19")
                        Sheets("DaftarPenjualan").Range("G" & lr4).Value = Sheet1.Range("D18")
                        Sheets("DaftarPenjualan").Range("H" & lr4).Value = cell2.Offset(0, 5)
                        Sheets("Sheet1").Range("B10").Value = Sheets("Sheet1").Range("B10").Value + 1
                        Set rConstants = Sheet1.Range("A16:C" & "C17").SpecialCells(xlCellTypeConstants)
                        rConstants.ClearContents

                    End If
                End If
        Next cell2
Next cell1

Sheets("Sheet1").Activate
End Sub

Answer 1

Попробуйте, если я предполагаю, что в вашем инвентаре нет повторяющихся предметов, иначе произойдет сбой при хранении предметов в словаре

Option Explicit
Sub printInvoice()

    Dim ws As Worksheet, wsInventory As Worksheet
    Dim LastRow As Long, LastRowInventory As Long, i As Long
    Dim DictInventory As Scripting.Dictionary 'You need to check Microsoft Scripting Runtime on your references for this to work
    Dim C As Range
    Dim Substract As Integer
    Dim arrInventory 'here we will store your inventory

    With ThisWorkbook 'with this you are referencing both sheets on this workbook so its shorter to call them
        Set ws = .Sheets("Sheet1")
        Set wsInventory = .Sheets("Sheet2")
    End With

    Set DictInventory = New Scripting.Dictionary
    LastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row 'this is to know how many items are sold

    With wsInventory
        LastRowInventory = .Cells(.Rows.Count, 2).End(xlUp).Row 'this is to get all your inventory
        arrInventory = .Range(.Cells(1, 2), .Cells(LastRowInventory, 4)).Value 'storing your inventory
    End With

    For i = 2 To UBound(arrInventory) 'here we loop through your inventory to know in which row is every item and store the row
        If Not arrInventory(i, 1) = vbNullString Then DictInventory.Add arrInventory(i, 1), arrInventory(i, 3)
    Next i

    With ws
        For Each C In .Range("B2:B" & LastRow) 'we are looping through the first sheet to substract the inventory
            Substract = .Cells(C.Row, 3)
            arrInventory(DictInventory(C.Value), 3) = arrInventory(DictInventory(C.Value), 3) - Substract
        Next C
    End With

    'Paste the values modified to the sheet
    wsInventory.Range(wsInventory.Cells(1, 2), wsInventory.Cells(LastRowInventory, 4)).Value = arrInventory

End Sub

Редактировать: Я не знаю, думали ли вы уже оэто, но во избежание проблем, я бы использовал список проверки данных на листе получения, чтобы подобрать продукт, который подается в инвентарном листе.Таким образом, не будет проблем с поиском некоторых продуктов для опечаток.