加速和簡化

我拼湊了一些對我有用的東西，但它運行得很慢，我確信代碼可以簡化。

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熱心網友回復：

看起來不錯，但它需要遍歷多個列。如果我舉一個原始資料的例子可能會有所幫助。

標籤：擅长 vba

上一篇：將多個作業簿（每個作業簿與一張作業表）合并為一個作業簿與多個作業表

下一篇：返回列表