Question

我将1个工作表中的采购订单模板中的条目拖入数据库工作表，该工作表将在同一Excel工作簿中记录所有采购订单日期。在订单模板选项卡上订购的SKU通常会超过1，并且会彼此不同。想知道如何将不同的SKU编号拉入数据库选项卡，并在下面编辑VBA代码：

Private Sub CommandButton1_Click()
    Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
    Worksheets("Order Form 1").Select
    OrderDate = Range("B3")
    PONumber = Range("D3")
    Vendor = Range("B7")
    ShipTo = Range("D7")
    SKU = Range("F3")
    R = 3
    Do While Cells(R, 6) <> ""
        Worksheets("Database").Select
        Worksheets("Database").Range("A1").Select
        If Worksheets("Database").Range("A1").Offset(1, 0) <> "" Then
            Worksheets("Database").Range("A1").End(xlDown).Select
        End If
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = OrderDate
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = PONumber
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = Vendor
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = ShipTo
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = SKU
        Worksheets("Order Form 1").Select
        R = R + 1
    Loop
End Sub

Answer 1

我同意所有.Selects和ActiveCell引用都很难看。但是，在尝试尽可能多地保留代码时，这里有一种方法：

Private Sub CommandButton1_Click()
    Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
    Dim R As Long, LastRow As Long
    Worksheets("Order Form 1").Select
    OrderDate = Range("B3")
    PONumber = Range("D3")
    Vendor = Range("B7")
    ShipTo = Range("D7")
    LastRow = Worksheets("Order Form 1").Cells(Worksheets("Order Form 1").Rows.Count, "F").End(xlUp).Row
    For R = 3 To LastRow
        SKU = Range("F" & R).Value
        Worksheets("Database").Select
        Worksheets("Database").Range("A1").Select
        If Worksheets("Database").Range("A1").Offset(1, 0) <> "" Then
            Worksheets("Database").Range("A1").End(xlDown).Select
        End If
        ActiveCell.Offset(1, 0).Select
        ActiveCell.Value = OrderDate
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = PONumber
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = Vendor
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = ShipTo
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = SKU
        Worksheets("Order Form 1").Select
    Next R
End Sub

这是努力消除.Selects和ActiveCell引用：

Private Sub CommandButton1_Click()
    Dim OrderDate As String, PONumber As String, Vendor As String, ShipTo As String, SKU As String
    Dim R As Long, LastSKURow As Long, NextDBRow As Long, OFrm As Worksheet, DB As Worksheet
    Set OFrm = Worksheets("Order Form 1")
    Set DB = Worksheets("Database")
    OrderDate = OFrm.Range("B3")
    PONumber = OFrm.Range("D3")
    Vendor = OFrm.Range("B7")
    ShipTo = OFrm.Range("D7")
    LastSKURow = OFrm.Cells(OFrm.Rows.Count, "F").End(xlUp).Row
    For R = 3 To LastSKURow
        SKU = OFrm.Range("F" & R).Value
        NextDBRow = DB.Cells(DB.Rows.Count, "A").End(xlUp).Row + 1
        DB.Range("A" & NextDBRow).Value = OrderDate
        DB.Range("B" & NextDBRow).Value = PONumber
        DB.Range("C" & NextDBRow).Value = Vendor
        DB.Range("D" & NextDBRow).Value = ShipTo
        DB.Range("E" & NextDBRow).Value = SKU
    Next R
End Sub

Excel VBA DoWhile循环 - 如何返回每个循环的项目列表？

1 个答案: