Диапазон значений VBA делает странно

Question

Итак, как мне это выразить? Я - ладья VBA ie, и я пытался создать файл Excel, и цель состоит в том, чтобы это был инвентарь всех предметов, один лист для размещения предметов, а другой - за то, что отдал их. Но это не проблема, дело в том, что я хотел иметь страницу под названием «База данных инвентаризации», где записаны все продукты, которые вывозятся, но моя ценность странная. (посмотрите на изображение)

Так что это экран ввода, и если я наберу это

, это вывод на другой лист, но я не я не хочу, чтобы оно было 0 Я заметил, что если я изменю ввод и добавлю 3 строки, это работает, но это мешает мне набрать более одного продукта это вывод, который я хочу получить, и я действительно не знаю, что не так с кодом

    Sub Btn_Clickweggegeven()

Dim x As Long
Dim Givenaway As Worksheet
Dim Inventory As Worksheet
Dim productn As String
Dim erow As Long
Dim rng As Range
Dim rownumber As Long
Dim row As Long

Dim wsData As Worksheet
Dim wsIn As Worksheet
Dim nextRow As Long

Dim BtnText As String
Dim BtnNum As Long
Dim strName As String

x = 2
Do While Cells(x, 1) <> ""

' go through each item on list
    productn = Cells(x, 1)

' if item is not new then add quanity to total Inventory
   With Worksheets("Inventory").Range("A:A")
            Set rng = .Find(What:=productn, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)


'if item is new add item to the bottom of Inventory list


            If rng Is Nothing Then
                erow = Worksheets("Inventory").Cells(1, 1).CurrentRegion.Rows.Count + 1
                Worksheets("Inventory").Cells(erow, 1) = Worksheets("Givenaway").Cells(x, 1)
                Worksheets("Inventory").Cells(erow, 2) = Worksheets("Givenaway").Cells(x, 2)
                Worksheets("Inventory").Cells(erow, 3) = Worksheets("Givenaway").Cells(x, 3)
                Worksheets("Inventory").Cells(erow, 4) = Worksheets("Givenaway").Cells(x, 4)
                 GoTo ende
             Else
                rownumber = rng.row

             End If
        End With

        Worksheets("Inventory").Cells(rownumber, 2).Value = Worksheets("Inventory").Cells(rownumber, 2).Value _
        - Worksheets("Givenaway").Cells(x, 2).Value

        Worksheets("Inventory").Cells(rownumber, 4).Value = Worksheets("Inventory").Cells(rownumber, 4).Value _
        + Worksheets("Givenaway").Cells(x, 2).Value
ende:
        x = x + 1

        Loop

'after complete delete items from Givenaway list
Worksheets("Givenaway").Select
    row = 2
    Do While Cells(row, 1) <> ""
    Range(Cells(row, 1), Cells(row, 3)).Select
    Selection.Delete
Loop





    Set wsIn = Worksheets("Givenaway")
Set wsData = Worksheets("Databaseinventory")

With wsData
  nextRow = .Cells(.Rows.Count, "A") _
    .End(xlUp).Offset(1, 0).row
End With




With wsData
  With .Cells(nextRow, 1)
    .Value = Now
    .NumberFormat = "mm/dd/yyyy hh:mm:ss"
  End With
  .Cells(nextRow, 2).Value = productn

  .Cells(nextRow, 3).Value = Worksheets("Databaseinventory").Cells(rownumber, 3).Value _
        + Worksheets("Givenaway").Cells(x, 2).Value


End With

End Sub

Answer 1

Этот код удаляет значение

Worksheets("Givenaway").Select
    row = 2
    Do While Cells(row, 1) <> ""
    Range(Cells(row, 1), Cells(row, 3)).Select
    Selection.Delete
Loop

до того, как эта строка скопирует его в Databaseinventory

Cells(nextRow, 3).Value = Worksheets("Databaseinventory").Cells(rownumber, 3).Value _
    + Worksheets("Givenaway").Cells(x, 2).Value

Это работает, если у вас есть 3 строки, потому что при выходе из Do While Cells(x, 1) <> "" l oop значение x будет равно 3. После удаления первой записи значение для третьей записи будет Worksheets("Givenaway").Cells(x, 2).Value.

Процедура обновления базы данных также должна находиться в пределах л oop

Option Explicit

Sub Btn_Clickweggegeven()

    Dim wb As Workbook, rng As Range
    Dim wsInv As Worksheet, wsGiven As Worksheet, wsData As Worksheet
    Dim iRow As Long, iDataRow As Long, iInvRow As Long
    Dim sProduct As String, nValue As Single

    Set wb = ThisWorkbook
    Set wsGiven = wb.Sheets("GivenAway")

    Set wsInv = wb.Sheets("Inventory")

    Set wsData = wb.Sheets("Databaseinventory")
    iDataRow = wsData.Cells(Rows.Count, 1).End(xlUp).row

    iRow = 2
    With wsGiven
        Do While .Cells(iRow, 1) <> ""
            sProduct = .Cells(iRow, 1)
            nValue = .Cells(iRow, 2)

            ' if item is not new then add quanity to total Inventory
            With wsInv.Range("A:A")
            Set rng = .Find(What:=sProduct, _
                              After:=.Cells(.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False)
            End With

            If rng Is Nothing Then
                iInvRow = wsInv.Cells(Rows.Count, 1).End(xlUp).row + 1
                wsInv.Cells(iInvRow, 1).Resize(1, 4).Value = .Cells(iRow, 1).Resize(1, 4).Value
            Else
                iInvRow = rng.row
                wsInv.Cells(iInvRow, 2).Value = wsInv.Cells(iInvRow, 2).Value - nValue
                wsInv.Cells(iInvRow, 4).Value = wsInv.Cells(iInvRow, 4).Value + nValue
            End If

            ' write to database
            iDataRow = iDataRow + 1
            With wsData.Cells(iDataRow, 1)
                .Value = Now
                .NumberFormat = "mm/dd/yyyy hh:mm:ss"
                .Offset(0, 1) = sProduct ' col B
                .Offset(0, 2) = wsInv.Cells(iInvRow, 3).Value + nValue ' col C ??
            End With
            iRow = iRow + 1
        Loop
    End With

    'delete from GivenAway
    wsGiven.Range("A2").Resize(iRow, 3).Delete
    MsgBox iRow - 2 & " records processed", vbInformation

End Sub