Excel VBA基於一列中的值選擇是轉移到下一空行還是先留空行

Question

我有一個工作簿，它有一個「主表」工作表，其中包含項目的所有產品。基於交貨階段欄（「BF」），它們被轉移到正確的舞臺表。 Layout of the Worksheets. Stage worksheets go up to 24. 6-24 are hidden.

產品按階段分類爲同一產品的類型或組。在不同的組之間有空行。目前我的代碼已將產品轉移到正確的階段，但不同產品組之間沒有分工。 View of Master Sheet sorted by Product, not by Stage.例如;在D10和D05之間應該有一個空行，因爲這是第一階段的下一個產品，但不同於D10。

我當前的代碼是這樣的：

Sub LineCopy() 

RowClear.ClearRows 

Dim LR As Long, i As Long, x As Long, xLR As Long, y As Long 
LR = Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp).Row 

Application.ScreenUpdating = False 

For i = 10 To LR 
    For x = 1 To 24 
     If Sheets("Master Sheet").Range("BF" & i).Value = x Then 
      Sheets("Master Sheet").Range("A" & i).EntireRow.Copy 
      Sheets("Stage " & x & " Sheet").Range("A" &  Rows.Count).End(xlUp).Offset(1).PasteSpecial (xlPasteValues) 
     End If 
    Next x 
Next i 

Application.CutCopyMode = False 

End Sub 

預先感謝您的幫助。

Answer 1

這裏的一個解決方案是添加一個給出產品/分組的列，然後您可以檢查主工作表上的值是否與工作表中的最新值匹配。

另一種選擇是跟蹤是否需要跳過一行。假設組中有一個舞臺可能有多個條目，那麼您需要使用數組爲每個舞臺表單獨分別進行跟蹤。

Sub LineCopy() 
    RowClear.ClearRows 

    Dim LR As Long, i As Long, x As Long, xLR As Long, y As Long 
    LR = Sheets("Master Sheet").Range("A" & Rows.Count).End(xlUp).Row 

    Application.ScreenUpdating = False 

    'Create an array to track whether each sheet needs to skip a line 
    'Default is False 
    Dim SkipLine(24) As Boolean 


    For i = 10 To LR 
     'Rather than looping twice, we will get the value of x from column BF 
     x = Sheets("Master Sheet").Range("BF" & i) 

     'If the cell is empty, x will be zero 
     If x = 0 Then 
      'We fill the array with the value of True every sheet 
      'They all need to skip a row now 
      For j = 1 To 24 
       SkipLine(j) = True 
      Next 
     Else 
      'If cell BF is not empty, we copy the row 
      Sheets("Master Sheet").Range("A" & i).EntireRow.Copy 
      'Find the empty cell at the bottom of the stage sheet 
      Set PasteRow = Sheets("Stage " & x & " Sheet").Range("A" & Rows.Count).End(xlUp).Offset(1) 
      'Check whether we need to skip a row for this Stage Sheet 
      If SkipLine(x) = True Then 
       'If we need to skip a row, offset the PasteRow variable by another row 
       Set PasteRow = PasteRow.Offset(1) 
       'Update the array to show that we no longer need to skip a line on this sheet 
       SkipLine(x) = False 
      End If 
      'Paste the data 
      PasteRow.PasteSpecial (xlPasteValues) 
     End If 
    Next i 

    Application.CutCopyMode = False 
End Sub