在VBA中定义范围/最后一行

Question

我正在尝试将数据从excelsheet导出到excel发票模板。我拥有的VBA代码将每行视为不同的发票，因此为每行制作不同的工作簿。如果我有3行中有3种产品的1张发票，此代码会将每个产品（行）视为单独的发票，这是不正确的。我想以一种方式修改它，如果在下一行中重复发票编号（PiNo），则意味着下一个产品（行）仅属于上述发票。我是VBA的新手，因此我从另一个站点获取了代码。

Here is the code:-

   Private Sub CommandButton1_Click()
   Dim r As Long
   Dim path As String
   Dim myfilename As String
   lastrow = Sheets(“CustomerDetails”).Range(“H” & Rows.Count).End(xlUp).Row
   r = 2
   For r = 2 To lastrow

   ClientName = Sheets("CustomerDetails").Cells(r, 6).Value
   Address = Sheets("CustomerDetails").Cells(r, 13).Value
   PiNo = Sheets("CustomerDetails").Cells(r, 5).Value
   Qty = Sheets("CustomerDetails").Cells(r, 9).Value
   Description = Sheets("CustomerDetails").Cells(r, 12).Value
   UnitPrice = Sheets("CustomerDetails").Cells(r, 10).Value
   Salesperson = Sheets("CustomerDetails").Cells(r, 1).Value
   PoNo = Sheets("CustomerDetails").Cells(r, 3).Value
   PiDate = Sheets("CustomerDetails").Cells(r, 4).Value
   Paymentterms = Sheets("CustomerDetails").Cells(r, 7).Value
   PartNo = Sheets("CustomerDetails").Cells(r, 8).Value
   Shipdate = Sheets("CustomerDetails").Cells(r, 14).Value
   Dispatchthrough = Sheets("CustomerDetails").Cells(r, 15).Value
   Modeofpayment = Sheets("CustomerDetails").Cells(r, 16).Value
   VAT = Sheets("CustomerDetails").Cells(r, 17).Value

   Workbooks.Open ("C:\Users\admin\Desktop\InvoiceTemplate.xlsx")
   ActiveWorkbook.Sheets("InvoiceTemplate").Activate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Z8”).Value = PiDate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AG8”).Value = PiNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AN8”).Value = PoNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B16”).Value = ClientName
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B17”).Value = Address
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B21”).Value = Shipdate
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“K21”).Value = Paymentterms
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“T21”).Value = Salesperson
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AC21”).Value = Dispatchthrough
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL21”).Value = Modeofpayment
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“B25”).Value = PartNo
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“J25”).Value = Description
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“Y25”).Value = Qty
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AF25”).Value = UnitPrice
   ActiveWorkbook.Sheets("InvoiceTemplate").Range(“AL39”).Value = VAT

   path = "C:\Users\admin\Desktop\Invoices\"
   ActiveWorkbook.SaveAs Filename:=path & PiNo & “.xlsx”
   myfilename = ActiveWorkbook.FullName
   ActiveWorkbook.Close SaveChanges:=True

   Next r

   End Sub

“ H”是产品列，数据从第2行开始。第1行是标题。

感谢您的任何帮助！

enter image description here

Answer 1

您的代码缺少声明。考虑到您的设计需要大量的变量，我认为最好的方法是声明Types。这是用户定义的结构化变量，基本上是具有命名元素的数组。由于您现在要在单独的操作中编写发票的抬头和正文（每个抬头的许多正文项目），因此发票正文和发票项目需要不同的类型。

Type Invoice
    ClientName As String
    Address As String
    PiNo As String
    PiDate As Date
    Salesperson As String
    PoNo As String
    VAT As Double
    PaymentTerms As String
    PaymentMode As String
    ShipDate As Date
    DispatchThrough As String
End Type

Type Item
    Qty As Double
    PartNo As String
    Description As String
    UnitPrice As Double
End Type

Private Sub CommandButton1_Click()

    Const InvoiceItemRow As Long = 25       ' modify to suit

    Dim WbInv As Workbook
    Dim Path As String
    Dim InvFileName As String
    Dim WsInv As Worksheet
    Dim WsCust As Worksheet                 ' always name your sheet
    Dim PiNo As String, Pi As String
    Dim Inv As Invoice, Itm As Item
    Dim Pos As Integer                      ' invoice item counter (1st item = 0)
    Dim NewInvoice As Boolean
    Dim LastRow As Long
    Dim R As Long

    Path = "C:\Users\admin\Desktop\Invoices\"
    ' you may like to use this syntax instead
    Path = Environ("UserProfile") & "\Desktop\Invoices\"

    ' Spaces are permitted in tab names. You may use "Customer Details"
    Set WsCust = ThisWorkbook.Worksheets("CustomerDetails")
    ' observe the leading period in .Rows.Count. That's why to use the With statement.
    With WsCust
        ' Use the Range object to define a range
        LastRow = .Range("H" & .Rows.Count).End(xlUp).Row
        ' but use the Cells collection to define a cell.
        LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
        ' delete the line you don't want to keep
    End With

    Application.ScreenUpdating = False          ' avoid flicker
    For R = 2 To LastRow
        Pi = WsCust.Cells(R, 5).Value
        If PiNo <> Pi Then
            NewInvoice = True
            If Not WbInv Is Nothing Then
                ' if there is a started invoice already, close it
               InvFileName = Path & Inv.PiNo & ".xlsx"
               With WbInv
                .SaveAs Filename:=InvFileName
                .Close SaveChanges:=True
               End With
            End If
            Inv = SetInvoice(R, WsCust)
        End If

        Itm = SetItem(R, WsCust)
        If NewInvoice Then
            ' if it's a template, save it with xltx or xltm extension
            ' and, in any case, create a copy with the Add Method
            Set WbInv = Workbooks.Add("C:\Users\admin\Desktop\InvoiceTemplate.xlsx")
            Set WsInv = WbInv.Worksheets("InvoiceTemplate")

            With WsInv
                .Cells(16, "B").Value = .ClientName
                .Cells(17, "B").Value = Inv.Address
                .Cells(8, "AG").Value = Inv.PiNo
                .Cells(8, "Z").Value = Inv.PiDate
                .Cells(21, "T").Value = Inv.Salesperson
                .Cells(8, "AN").Value = Inv.PoNo
                .Cells(39, "AL").Value = Inv.VAT
                .Cells(21, "K").Value = Inv.PaymentTerms
                .Cells(21, "AL").Value = Inv.PaymentMode
                .Cells(21, "B").Value = Inv.ShipDate
                .Cells(21, "AC").Value = Inv.DispatchThrough
            End With
            Pos = 0                             ' reset item counter
        Else
            Pos = Pos + 1
        End If

        With WsInv.Rows(InvoiceItemRow + Pos)
            ' find out the column number with Debug.Print ? Columns("AF").Column
            .Cells(2).Value = PartNo
            .Cells(10).Value = Description
            .Cells(25).Value = Qty
            .Cells(32).Value = UnitPrice
        End With
        PiNo = Pi
    Next R
    Application.ScreenUpdating = True
End Sub

Private Function SetInvoice(ByVal R As Long, _
                            Ws As Worksheet) As Invoice

    Dim Fun As Invoice

    With Fun
        .ClientName = Ws.Cells(R, 6).Value
        .Address = Ws.Cells(R, 13).Value
        .PiNo = Ws.Cells(R, 5).Value
        .PiDate = Ws.Cells(R, 4).Value
        .Salesperson = Ws.Cells(R, 1).Value
        .PoNo = Ws.Cells(R, 3).Value
        .VAT = Ws.Cells(R, 17).Value
        .PaymentTerms = Ws.Cells(R, 7).Value
        .PaymentMode = Ws.Cells(R, 16).Value
        .DispatchThrough = Ws.Cells(R, 15).Value
        .ShipDate = Ws.Cells(R, 14).Value
    End With
End Function

Private Function SetItem(ByVal R As Long, _
                         Ws As Worksheet) As Item

    Dim Fun As Item

    With Fun
        .Qty = Ws.Cells(R, 9).Value
        .PartNo = Ws.Cells(R, 8).Value
        .Description = Ws.Cells(R, 12).Value
        .UnitPrice = Ws.Cells(R, 10).Value
    End With

    SetItem = Fun
End Function

除保存和关闭部分外，我已经全面测试了此代码。如果您进行更彻底的测试后发现错误，请多多包涵，让我知道，我将纠正它们。