Excel VBA根据一列中的值选择是转移到下一个空行还是首先保留一个空行

Question

我有一个工作簿，其中有一个“主表”工作表，其中包含项目的所有产品。 然后根据交货阶段列（“ BF”）将它们转移到正确的阶段表。 工作表的布局。 阶段工作表最多可增加24个。6-24被隐藏。

产品不是按阶段分类为同一产品的类型或组。 不同组之间有空行。 目前，我已将代码转移到正确的阶段，但没有将产品划分为不同的组。 主表视图按产品而不是按阶段排序。 例如; 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

这里的一种解决方案是添加一列给出产品/分组的列，然后您只需检查“主表”上的值是否与阶段表中的最新值匹配即可。

另一种选择是跟踪是否需要跳过一行。 假设可以在一个组中的一个阶段有多个条目，则需要使用数组为每个“阶段”表分别跟踪该条目。

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