我拼湊了一些對我有用的東西，但它運行得很慢，我確信代碼可以簡化。
Sub CopyPasteValues()
Dim strSht1, strSht2 As String
Dim c, rng As Range
strSht1 = "Edit"
strSht2 = "LOB"
With ThisWorkbook.Sheets(strSht1)
Set rng = Range("J2:AJ37")
For Each c In rng
If Not c.Value = 0 Then
Cells(c.Row, 2).Copy
ThisWorkbook.Sheets(strSht2).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Range(Cells(c.Row, 4), Cells(c.Row, 5)).Copy
ThisWorkbook.Sheets(strSht2).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
c.Copy
ThisWorkbook.Sheets(strSht2).Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Cells(c.Column).Copy
ThisWorkbook.Sheets(strSht2).Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Next c
End With
End Sub
我感謝任何幫助。
uj5u.com熱心網友回復：
正如 BigBen 所提到的，陣列方法。超級快。
Sub Move_Values_Array_Method()
Dim SourceSheet As Worksheet 'Source Worksheet
Dim DestinationSheet As Worksheet 'Destination Worksheet
Dim RG As Range 'Source Range
Dim InArr() 'Data In Array
Dim OutArr() 'Data Out Array
Dim X As Long 'Array X Position for purposes of iterating through array.
Dim Y As Long 'Array Y Position for purposes of iterating through array.
Dim Cnt As Long 'Found Value Count
Set SourceSheet = ThisWorkbook.Worksheets("Edit") 'Set Source Worksheet
Set DestinationSheet = ThisWorkbook.Worksheets("LOB") 'Set Dest Worksheet
Set RG = SourceSheet.Range("J2:AJ37") 'Set Source Range
ReDim OutArr(1 To RG.Cells.Count) 'Count Cells in Range, resize output array to be at least that big.
InArr = RG 'Transfer Range Data to Array
Cnt = 0
Debug.Print LBound(InArr, 1) & " - " & UBound(InArr, 1) 'Rows
Debug.Print LBound(InArr, 2) & " - " & UBound(InArr, 2) 'Columns
For Y = 1 To UBound(InArr, 1) 'For Each Row in Array (or each Y position)
For X = 1 To UBound(InArr, 2) 'For Each Column in Array (or each X position)
If InArr(Y, X) <> "" Then 'If not blank Value (you can change this to "If InArr(Y, X) <> 0 Then" if that works best for you.
Cnt = Cnt 1 'Increment "found value count" by 1
OutArr(Cnt) = InArr(Y, X) 'Add found value to output array
End If
Next X
Next Y
'Output to Dest Sheet
DestinationSheet.Range("F2").Resize(UBound(OutArr, 1), 1).Value = Application.Transpose(OutArr())
End Sub
uj5u.com熱心網友回復：
根據您之前評論中的資訊，使用公式和過濾器嘗試這些替代解決方案......
1) 陣列公式
要注意：
- 為了清楚起見，我將所有內容都放在了一張紙上，但它在多張紙甚至作業簿上也同樣適用。
- 如果要過濾整個作業表，以相同的列順序，您只需輸入一次公式并在公式中展開“陣列”條件以封裝整個資料集。
單元格“J4”中使用的公式 =“=FILTER($I$4:$I$30,$C$4:$C$30>0)”
（過濾范圍 I4 到 I30 以顯示 C4 到 C30 范圍內的值大于的行0)
2）直接過濾
或者，您可以（手動或以編程方式）將所有資料復制到 LOB 表，（或有選擇地復制），然后過濾 Qty>0。
uj5u.com熱心網友回復：
看起來不錯，但它需要遍歷多個列。如果我舉一個原始資料的例子可能會有所幫助。
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/508294.html