Блог

В моем Excel есть 2 листа: «Лист1» предназначен для получения, а «Лист2» — для инвентаризации запасов. что я хочу сделать, так это когда пользователь вставляет название продукта в строки A16 и A17, обновляется количество товара из «Листа 2» с тем же именем. Созданный мной код может обновлять элемент количества из ячейки A16, но элемент количества ячейки A17 не обновляется (показано на рисунке). кто-нибудь знает, что не так с моим кодом? На изображении есть 2 товара: cheese Cheetos и hot Cheetos. когда я делаю свою квитанцию, уменьшается количество только сыра Cheetos изображение

Вот код

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

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

Dim lr4 As Long
lr4 = Sheets("DaftarPenjualan").Range("A" amp; 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" amp; lr4).Value = Sheet1.Range("B11")
                        Sheets("DaftarPenjualan").Range("B" amp; lr4).Value = Sheet1.Range("B10")
                        Sheets("DaftarPenjualan").Range("C" amp; lr4).Value = Sheet1.Range("A16")
                        Sheets("DaftarPenjualan").Range("D" amp; lr4).Value = Sheet1.Range("C16")
                        Sheets("DaftarPenjualan").Range("F" amp; lr4).Value = Sheet1.Range("D19")
                        Sheets("DaftarPenjualan").Range("G" amp; lr4).Value = Sheet1.Range("D18")
                        Sheets("DaftarPenjualan").Range("H" amp; lr4).Value = cell2.Offset(0, 5)
                        Sheets("Sheet1").Range("B10").Value = Sheets("Sheet1").Range("B10").Value   1
                        Set rConstants = Sheet1.Range("A16:C" amp; "C17").SpecialCells(xlCellTypeConstants)
                        rConstants.ClearContents

                    End If
                End If
        Next cell2
Next cell1

Sheets("Sheet1").Activate
End Sub
  

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

 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" amp; 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
  

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