使用 VBA 代码将数据从发票移动到销售摘要页面

Question

我正在为我的一个朋友创建一个数据库。她拥有一家小商店，人们可以在那里购买手工艺品。我创建了一个工匠清单和库存清单。在两张表上，我有一个发票清单，该清单根据商品代码（使用 Vloolup）从库存清单中调用数据，并应用工匠的 2 个字母标识。然后我有一个 VBA 公式，它将每张发票中的数据移动到销售表中，该表保存每笔销售的数据，即使在发票结清后也是如此。这是我用来将每张发票中的数据传输到“销售”表的代码。

我附上了发票页的副本，以便你可以看到我的代码来自哪里

代码：

Sub SavingSalesData()
Dim rng As Range
  Dim i As Long
  Dim a As Long

  Dim rng_dest As Range
  Application.ScreenUpdating = False
  'Check if invoice # is found on sheet "Sales"
  i = 2
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      'Ask overwrite invoice #?
      If MsgBox("Invoice Number Already Used- Do you want to copy over?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Sales").Range("F:K")
  'Delete rows if invoice # is found
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      Sheets("Sales").Range("C" & i).EntireRow.Delete
      i = 1
    End If
    i = i + 2
  Loop
  ' Find first empty row in columns C:K on sheet Sales

    Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  'Copy range A8:E27 on sheet Invoice
  Set rng = Sheets("Invoice").Range("A7:F27")
  ' Copy rows containing values to sheet Sales
 For a = 2 To rng.Rows.count

    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy Invoice number
      Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value
      'Copy Date
      Sheets("Sales").Range("D" & i).Value = Sheets("Invoice").Range("C3").Value
      'Copy Company name
      Sheets("Sales").Range("E" & i).Value = Sheets("Invoice").Range("C5").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub

代码结束：

我的问题是，当我保存每张发票时，发票中的所有空白行也会显示出来：

有什么方法可以改变这种情况，以便只有发票中使用的行才会显示在“销售”表上？

Answer 1

不要使用发票的整个范围，只需使用您知道有数据的部分：

With Sheets("Invoice")
    Dim lastRow as Long
    Dim rng as Range
    lastRow = .cells(.rows.count, 1).end(xlup).row
    Set rng = .Range(.Cells(8, 1), .Cells(lastRow, 6))
End With

Answer 2

Sub Luu_HoaDon()
Dim rng As Range
  Dim i As Long
  Dim a As Long

  Dim rng_dest As Range
  Application.ScreenUpdating = False
  'Kiêm tra só Hóa don có trong sheet "Sales"
  i = 2
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      'Hoi truóc khi ghi dè só Hóa don?
      If MsgBox("Trùng só Hóa don, Ban có ghi dè không?", vbYesNo) = vbNo Then
        Exit Sub
      Else
        Exit Do
      End If
    End If
    i = i + 1
  Loop
  i = 1
  Set rng_dest = Sheets("Sales").Range("F:K")
  'Ghi dè néu trùng só Hóa don
  Do Until Sheets("Sales").Range("C" & i).Value = ""
    If Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value Then
      Sheets("Sales").Range("C" & i).EntireRow.Delete
      i = 1
    End If
'    i = i + 2 '(chõ này nó cách 1 dòng tróng
    i = i + 1 'Thay 2 = 1 nó hét 1 dòng tróng
  Loop
  'Tìm dòng tróng côt C:K cua sheet Sales de ghi

    Do Until WorksheetFunction.CountA(rng_dest.Rows(i)) = 0
    i = i + 1
  Loop
  '///////////////
  'Copy range A8:E27 on sheet Invoice
'  Set rng = Sheets("Invoice").Range("A7:F27")  'Thay dòng này bàng 5 dòng ké tiép

    With Sheets("Invoice")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Range(.Cells(7, 1), .Cells(lastRow, 6))
    End With
'/////////////
  ' Copy Value tù Hóa don vào sheet Sales
 For a = 2 To rng.Rows.Count

    If WorksheetFunction.CountA(rng.Rows(a)) <> 0 Then
      rng_dest.Rows(i).Value = rng.Rows(a).Value
      'Copy só Hóa don
      Sheets("Sales").Range("C" & i).Value = Sheets("Invoice").Range("E3").Value
      'Copy Date
      Sheets("Sales").Range("D" & i).Value = Sheets("Invoice").Range("C3").Value
      'Copy Company name
      Sheets("Sales").Range("E" & i).Value = Sheets("Invoice").Range("C5").Value
      i = i + 1
    End If
  Next a
  Application.ScreenUpdating = True
End Sub