Excel VBA 1つの列の値に基づいて、次の空行に転送するか、空の行を最初に残すかを選択します。

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の間に空の行があるはずです。これはステージ1の次の製品ですが、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

ここでは、製品/グループを示す列を追加することで、マスターシートの値がステージシートの最新値と一致するかどうかを確認できます。

もう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