Question

所有，我正在创建一个vba代码，只需单击一下按钮即可将数据保存在表单上。我已经制定了代码，但是目前提交时间太长，因此我正在努力缩短代码。这是原始代码的片段。

Sub TransferDeliveryInfoB13()

Sheets("Parts In-Out Form").Select

Range("d9").Select

If ActiveCell.Value = ("In") And (Sheets("Parts In-Out Form").Range("b13") > 0) Then

    'Copy Part Number'
    Dim LastRow As Long
    LastRow = Sheets("Deliveries").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    Sheets("Parts In-Out Form").Range("b13").Copy
    Sheets("Deliveries").Cells(LastRow, 3).PasteSpecial xlPasteValues

    'Copy Back Ordered Quanity'
    Sheets("Parts In-Out Form").Range("c13").Copy
    Sheets("Deliveries").Cells(LastRow, 9).PasteSpecial xlPasteValues

    'Copy Back Order ETA
    Sheets("Parts In-Out Form").Range("c9").Copy
    Sheets("Deliveries").Cells(LastRow, 10).PasteSpecial xlPasteValues

    'Copy Quanity'
    Sheets("Parts In-Out Form").Range("d13").Copy
    Sheets("Deliveries").Cells(LastRow, 4).PasteSpecial xlPasteValues

    'Copy Employee Number
    Sheets("Parts In-Out Form").Range("f9").Copy
    Sheets("Deliveries").Cells(LastRow, 5).PasteSpecial xlPasteValues

    'Copy BOL Number
    Sheets("Parts In-Out Form").Range("h9").Copy
    Sheets("Deliveries").Cells(LastRow, 2).PasteSpecial xlPasteValues

    'Copy PO Number
    Sheets("Parts In-Out Form").Range("f12").Copy
    Sheets("Deliveries").Cells(LastRow, 8).PasteSpecial xlPasteValues

    'Copying Whether or Not Back Order Delivery
    Sheets("Parts In-Out Form").Range("h12").Copy
    Sheets("Deliveries").Cells(LastRow, 12).PasteSpecial xlPasteValues

    'Copying Date
    Sheets("Parts In-Out Form").Range("b9").Copy
    Sheets("Deliveries").Cells(LastRow, 1).PasteSpecial xlPasteValues

    Call TransferDeliveryInfoB14

    Else

        Sheets("Deliveries").Select
        ActiveSheet.Protect ("mustache")

        Sheets("Parts In-Out Form").Range("B9,D9,F9,H9,C9,F12,B12:B42,C12:C42,D12:D42,H12").ClearContents

    End If

 End Sub
 Sub TransferDeliveryInfoB14()

Sheets("Parts In-Out Form").Select

Range("d9").Select

If ActiveCell.Value = ("In") And (Sheets("Parts In-Out Form").Range("b14") > 0) Then

    'Copy Part Number'
    Dim LastRow As Long
    LastRow = Sheets("Deliveries").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    Sheets("Parts In-Out Form").Range("b14").Copy
    Sheets("Deliveries").Cells(LastRow, 3).PasteSpecial xlPasteValues

    'Copy Back Ordered Quanity'
    Sheets("Parts In-Out Form").Range("c14").Copy
    Sheets("Deliveries").Cells(LastRow, 9).PasteSpecial xlPasteValues

    'Copy Back Order ETA
    Sheets("Parts In-Out Form").Range("c9").Copy
    Sheets("Deliveries").Cells(LastRow, 10).PasteSpecial xlPasteValues

    'Copy Quanity'
    Sheets("Parts In-Out Form").Range("d14").Copy
    Sheets("Deliveries").Cells(LastRow, 4).PasteSpecial xlPasteValues

    'Copy Employee Number
    Sheets("Parts In-Out Form").Range("f9").Copy
    Sheets("Deliveries").Cells(LastRow, 5).PasteSpecial xlPasteValues

    'Copy BOL Number
    Sheets("Parts In-Out Form").Range("h9").Copy
    Sheets("Deliveries").Cells(LastRow, 2).PasteSpecial xlPasteValues

    'Copy PO Number
    Sheets("Parts In-Out Form").Range("f12").Copy
    Sheets("Deliveries").Cells(LastRow, 8).PasteSpecial xlPasteValues

    'Copying Whether or Not Back Order Delivery
    Sheets("Parts In-Out Form").Range("h12").Copy
    Sheets("Deliveries").Cells(LastRow, 12).PasteSpecial xlPasteValues

    'Copying Date
    Sheets("Parts In-Out Form").Range("b9").Copy
    Sheets("Deliveries").Cells(LastRow, 1).PasteSpecial xlPasteValues

    Call TransferDeliveryInfoB15

    Else

        Sheets("Deliveries").Select
        ActiveSheet.Protect ("mustache")

        Sheets("Parts In-Out Form").Range("B9,D9,F9,H9,C9,F12,B12:B42,C12:C42,D12:D42,H12").ClearContents

    End If

 End Sub

我试图做的是将每个单元格压缩成一个代码，而不是一百万if语句，它将复制并粘贴零件号和数量。如果有值，它将在行的相应列中复制bol，日期，员工编号。这是我到目前为止所拥有的。

Sub TransferDeliveryInfoB12()

'make sure to unlock sheet
    Sheets("Deliveries").Select
    ActiveSheet.Unprotect ("mustache")

Sheets("Parts In-Out Form").Select

Range("d9").Select

If ActiveCell.Value = ("In") Then

    Dim LastRow As Long
    LastRow = Sheets("Deliveries").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    'Copy Parts Number
    Sheets("Parts In-Out Form").Range("b12:b42").Copy
    Sheets("Deliveries").Cells(LastRow, 3).PasteSpecial xlPasteValues

    'Copy Back Ordered Quanity
    Sheets("Parts In-Out Form").Range("c12:c42").Copy
    Sheets("Deliveries").Cells(LastRow, 9).PasteSpecial xlPasteValues

    'Copy Parts Quanity
    Sheets("Parts In-Out Form").Range("b12:b42").Copy
    Sheets("Deliveries").Cells(LastRow, 4).PasteSpecial xlPasteValues

我真的不确定从这一点出发。在此先感谢您的全方位指导和帮助。

Answer 1

您的代码应该真正精简为这样的样子-一对循环循环，但是您需要多次多次在B列中输入值-尽管，您必须在第二个数组中添加一些棘手的内容（{{ 1}}），因为这在整个子例程中都不一致-简短的示例很抱歉：

arr2

Answer 2

弄清楚了。这就是我最后得到的。

`
子TransferDeliveryInfo（）

 Application.EnableEvents = False
 Application.ScreenUpdating = False

'make sure to unlock sheet
    Sheets("Deliveries").Select
    ActiveSheet.Unprotect ("mustache")

    Dim n As Integer
    Dim j As Integer
    n = 11
    Do Until n = 43
        n = n + 1

 If Sheets("Parts In-Out Form").Range("b" & n) > 0 Then

    'Copy Part Number'
    Dim LastRow As Long
    LastRow = Sheets("Deliveries").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

    Sheets("Deliveries").Cells(LastRow, 3) = Sheets("Parts In-Out Form").Range("b" & n)

    'Copy Back Ordered Quanity'
    Sheets("Deliveries").Cells(LastRow, 9) = Sheets("Parts In-Out Form").Range("d" & n)

    'Copy Back Order ETA
    Sheets("Deliveries").Cells(LastRow, 10) = Sheets("Parts In-Out Form").Range("e" & n)

    'Copy Quanity'
    Sheets("Deliveries").Cells(LastRow, 4) = Sheets("Parts In-Out Form").Range("c" & n)

    'Copy Employee Number
    Sheets("Deliveries").Cells(LastRow, 5) = Sheets("Parts In-Out Form").Range("g9")

    'Copy BOL Number
    Sheets("Deliveries").Cells(LastRow, 2) = Sheets("Parts In-Out Form").Range("i9")

    'Copy PO Number
    Sheets("Deliveries").Cells(LastRow, 8) = Sheets("Parts In-Out Form").Range("g12")

    'Copying Whether or Not Back Order Delivery
    Sheets("Deliveries").Cells(LastRow, 12) = Sheets("Parts In-Out Form").Range("i12")

    'Copying Date
    Sheets("Deliveries").Cells(LastRow, 1) = Sheets("Parts In-Out Form").Range("b9")

    Else

    Sheets("Deliveries").Select
    ActiveSheet.Protect ("mustache")

    Sheets("Parts In-Out Form").Range("B9,D9,G9,I9,G12,I12,B12:B42,C12:C42,D12:D42,E12:E42").ClearContents

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    End If

    Loop

 End Sub

`

无法开发vba代码以复制和复制某些单元格并依赖于它们是否粘贴（如果另一个单元格中有值）

2 个答案: