[英]Trouble developing vba code to copy and certain cells and paste them dependent if there is a value in another cell
所有，我正在創建一個 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 then 語句將其壓縮到一個代碼中，它將復制和粘貼零件編號和數量。 如果有值，它將復制行中相應列中的 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
我真的不知道從這一點去哪里。 在此先感謝您提供的所有方向和幫助。
您的代碼真的應該被壓縮為這樣的東西 - 幾個循環迭代你需要為 B 列中的值進行多少次 - 雖然，你必須在第二個數組（ arr2 ）中添加一些棘手的東西，因為那不是在整個子程序中保持一致 - 對於簡短的例子很抱歉：
Option Explicit
Dim sht As Worksheet, destsht As Worksheet
Dim i As Long, j As Long
Dim arr As Variant, arr2 As Variant
Sub TransferDeliveryInfoB13()
Set sht = Sheets("Parts In-Out Form")
Set destsht = Sheets("Deliveries")
arr = Array(3, 9, 10, 4, 5, 2, 8, 12, 1)
arr2 = Array("B13", "C13", "C9", "D13", "F9", "H9", "F12", "H12", "B9")
Dim LastRow As Long
LastRow = destsht.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
j = 0
For i = 13 To 15
If sht.Range("D9").Value = "In" And sht.Range("B" & i) > 0 Then
For j = 0 To UBound(arr)
destsht.Cells(LastRow, arr(j)).Value = sht.Range(arr2(j)).Value
Next j
Else
destsht.Protect ("mustache")
sht.Range("B9,D9,F9,H9,C9,F12,B12:B42,C12:C42,D12:D42,H12").ClearContents
End If
Next i
End Sub
弄清楚了。 這就是我的結果。
`
Sub 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中使用特定字符串名稱復制/粘貼單元格時出現問題
[英]Trouble with Copy/Paste Cells with a Certain String Name in Them, VBA
Excel VBA宏可根據列中的文本將單元格值復制並粘貼到某些單元格
[英]Excel VBA Macros to copy and paste cell value to certain cells based on text in column
VBA代碼可根據條件復制特定列中的單元格並將其粘貼（值）到另一張工作表中特定列中的單元格
[英]VBA code to copy cells in specific column and paste (value) it to cells in specific column on another Sheet based on conditions
Excel VBA按特定順序檢查單元格，然后從另一個單元格中的其中一個返回值
[英]Excel VBA checks cells in certain order before returning a value from one of them in another cell
VBA代碼可將特定單元格中的特定單詞復制並粘貼到另一個工作表中
[英]VBA code to copy and paste specifc words in different cells to another worksheet
Excel宏，根據另一個單元格值復制和粘貼多個單元格？
[英]Excel macro, to copy and paste a multiple cells based on another cell value?
復制並粘貼具有依賴於具有相對值的鎖定單元格（來自參考單元格）的信息的單元格數組
[英]Copy and Paste an array of cells with information dependent on a lock cell (from a reference cell) with relative value
我想復制一系列單元格並將它們粘貼到另一個工作表，具體取決於下拉選擇並使用按鈕激活
[英]I want to copy a range of cells and paste them to another sheet dependent on a drop down selection and activated using a button
VBA代碼可在其旁邊查找值復制值並粘貼到其他單元格中
[英]VBA code to look for value copy value next to it and paste in different cell
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.