在 VBA 中定义范围/ lastrow

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, FileFormat:=xlOpenXMLWorkbook
                .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
            NewInvoice = False
        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

除了 Save & Close 部分外，我已经草率地测试了这段代码。如果您更彻底的测试发现错误，请多多包涵，让我知道，我会更正它们。

测试 SaveAs 过程 ==============（2020 年 4 月 7 日编辑）

下面的过程是上面的摘录。 SaveAs 使用与上述代码相同的语法。请按照以下步骤操作。

1. 从您的 InvoiceTemplate 创建一个新工作簿。它的名字应该是InvoiceTemplate1 并且以前从未保存过。将其设为 ActiveWorkbook。
2. 修改过程以创建InvFilename 变量，方法与您的代码完全相同。

3. 然后运行程序。

   私有子 TestSaveAs()

   Dim WbInv As Workbook
   Dim InvFilename As String
   
   Set WbInv = ActiveWorkbook
   InvFilename = Environ("UserProfile") & "\Desktop\MyWorkbook.xlsx"
   With WbInv
    .SaveAs Filename:=InvFilename, FileFormat:=xlOpenXMLWorkbook
    .Close SaveChanges:=True
   End With
   

   结束子