如何使用VBA将记录从Excel表单存储到不同的行？

so I have this invoice form that looks like this in Sheet Invoice_Form of an Excel workbook InvoiceForm.xlsm:

所以我在Excel工作簿InvoiceForm.xlsm的Sheet Invoice_Form中有这样的发票表单:

and a database of invoice records in Sheet Invoice Database of an Excel workbook InvoiceDatabase.xlsm:

和Excel工作簿InvoiceDatabase.xlsm的工作表发票数据库中的发票记录数据库:

I have created VBA codes that can link records from the form to the invoice database, but what the code manages to do right now is only recording the first row of the invoice form:

我已经创建了可以将表单中的记录链接到发票数据库的VBA代码,但是代码管理的目前只是记录发票表单的第一行:

The code looks like this:

代码如下所示:

Sub Submit_Invoice()

  Dim LastRow As Long, ws As Worksheet

  Set ws = Sheets("InvoiceDatabase") 

  LastRow = ws.Range("I" & Rows.Count).End(xlUp).Row + 1 

  ws.Range("K" & LastRow).Value = Worksheets("Invoice Form").Range("C9:C16").Value 
  ws.Range("L" & LastRow).Value = Worksheets("Invoice Form").Range("D9:D16").Value
   ....

 End Sub

So the question is: How do I modify my code so that it can create multiple records on different rows based on this one form if there are additional products added in the invoice form?

所以问题是:如果在发票表单中添加了其他产品,我如何修改我的代码,以便它可以根据这一个表单在不同的行上创建多个记录?

Thanks!

2 个解决方案

#1

Build an array from the form and dump the array into the InvoiceDatabase.

从表单构建数组并将数组转储到InvoiceDatabase中。

Sub Submit_Invoice()

    Dim lr As Long, ws As Worksheet
    dim arr as variant, i as long

    with Worksheets("Invoice Form")
        lr = .cells(16, "C").end(xlup).row - 8
        redim arr(1 to lr, 1 to 6)
        for i=lbound(arr,1) to ubound(arr, 1)
            arr(i, 1) = .cells(5, "D").value
            arr(i, 2) = .cells(6, "D").value
            arr(i, 3) = .cells(i+8, "C").value
            arr(i, 4) = .cells(i+8, "D").value
            arr(i, 5) = .cells(i+8, "E").value
            arr(i, 6) = .cells(i+8, "F").value
        next i
    end with

    WITH WORKSheets("InvoiceDatabase")
        lr = .Range("I" & .Rows.Count).End(xlUp).Row + 1
        .cells(lr, "I").resize(ubound(arr, 1), ubound(arr, 2)) = arr
    end with

 End Sub

#2

You really should use a form/access database or Excel data form (2016) to do this.

您真的应该使用表单/访问数据库或Excel数据表单(2016)来执行此操作。

That said, your code is overwriting each row as your write to the other sheet as it isn't incremented. Also, you are missing how you add dates and invoice numbers.

也就是说,您的代码将覆盖每一行作为您对另一个工作表的写入,因为它不会增加。此外,您错过了添加日期和发票号码的方式。

The following uses more meaningful names and adds in the missing data, along with some basic error checks (e.g. there is data to transfer) and housekeeping in terms of clearing the form after transfer.

以下使用更有意义的名称并添加缺失的数据,以及一些基本的错误检查(例如,有数据要传输)和管理,以便在传输后清除表单。

Option Explicit
Public Sub Submit_Invoice()
    Dim nextRowDest As Long, lastRowSource As Long, wsDest As Worksheet, wsSource As Worksheet, transferData As Range
    Dim invoiceInfo As Range
    Application.ScreenUpdating = False

    Set wsDest = ThisWorkbook.Worksheets("InvoiceDatabase")
    Set wsSource = Workbooks("Invoice_Form.xlsm").Worksheets("Invoice Form")

    With wsSource
        lastRowSource = wsSource.Range("C" & .Rows.Count).End(xlUp).Row
        If lastRowSource < 9 Then Exit Sub       '<==No data
        Set transferData = .Range("C9:G" & lastRowSource)
        Set invoiceInfo = .Range("D5:D6")
    End With

    With wsDest
        nextRowDest = wsDest.Range("I" & Rows.Count).End(xlUp).Row + 1
        If nextRowDest < 4 Then Exit Sub         '<==Assume headers are in row 3
        transferData.Copy .Range("K" & nextRowDest)
        invoiceInfo.Copy
        .Range("I" & nextRowDest).Resize(transferData.Rows.Count, invoiceInfo.Rows.Count).PasteSpecial Transpose:=True
    End With

    transferData.ClearContents
    invoiceInfo.ClearContents

    Application.ScreenUpdating = True

End Sub

#1