Question

我对VBA还是很陌生，我已经尽力进行了搜索，但仍然找不到答案。我需要编写一个宏，它将基于多个条件插入新行。行必须成组，不超过5个，并用载波分隔。但是，如果容器在重复，则计为1行。

当前：

Container   Carrier
ABC56   Carrier 1
XOS752  Carrier 1
IOW45   Carrier 1
WOFJ74  Carrier 1
NMC85   Carrier 1
DDJD7   Carrier 1
DFF789  Carrier 1
DFF789  Carrier 1
CSGS    Carrier 1
GSW132  Carrier 1
WYWI78  Carrier 1
WTS758  Carrier 1
MNV74   Carrier2
ADS78   Carrier2
CTDS45  Carrier2
CTDS45  Carrier2
LHKGL78 Carrier2
XJSS772 Carrier2
XJSHS7  Carrier2
OIJS7   Carrier2

所需：

ABC56   Carrier 1
XOS752  Carrier 1
IOW45   Carrier 1
WOFJ74  Carrier 1
NMC85   Carrier 1

DDJD7   Carrier 1
DFF789  Carrier 1
DFF789  Carrier 1
CSGS    Carrier 1
GSW132  Carrier 1
WYWI78  Carrier 1

WTS758  Carrier 1

MNV74   Carrier2
ADS78   Carrier2
CTDS45  Carrier2
CTDS45  Carrier2
LHKGL78 Carrier2
XJSS772 Carrier2

XJSHS7  Carrier2
OIJS7   Carrier2

我会指引你的方向！我分别有这两个代码。 “一个按载波分隔”和“一个分隔成5行增量”。但是，它并没有内置所有逻辑。

分成5组：

Option Explicit
    Sub InsertIT()
    Dim x As Integer
    x = 1 'Start Row
    Do
    Range("A" & x, "B" & x).Insert
    x = x + 6
    Loop
    End Sub

要按运营商分隔：

 Sub InsertRowAtChangeInValue()
       For lRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row To 2 Step -1
          If Cells(lRow, "B") <> Cells(lRow - 1, "B") Then Rows(lRow).EntireRow.Insert
       Next lRow
    End Sub

Answer 1

我复制了示例数据，此宏为我提供了您要查找的输出。

我使用while循环而不是for循环，因为VBA在开始时记录for循环结束时的值以及需要处理的行数插入行时更改。

我使用的是计数器的概念，该计数器仅在满足条件时才递增，以说明重复的容器行和载体行。

我还使用标志设置的概念来在检测到载波改变时采取正确的措施。在学习和发展vba的过程中，如果您选择使用标志，请记住要按照我在此处的说明进行必要的重置。

最后，我在结尾处包含了用户消息，作为对宏功能的快速认知检查。根据用户消息，您可以快速滚动到指示的行，并检查宏是否处理了整个工作表。我发现包含这些消息以检查我的工作并帮助我的用户发现错误很有帮助。

如有疑问，请发表评论！

Sub RowInsert()

'Designate your data columns
ContainerCol = "A"
CarrierCol = "B"

'Designate where your data starts
FirstDataRow = 2

'Find last row to process
LastRow = Range(ContainerCol & Rows.Count).End(xlUp).Row

'Initialize variable for row counter
RowCount = 0

'Initialize while loop variable
i = FirstDataRow

'Loop while ContainerCol is populated
While Not IsEmpty(Cells(i, ContainerCol))

    'Check if container and carrier are repeated from previous row. Increment counter if no repetition
    If Cells(i, CarrierCol) <> Cells(i - 1, CarrierCol) Or Cells(i, ContainerCol) <> Cells(i - 1, ContainerCol) Then
        RowCount = RowCount + 1
    End If

    'Check if carrier changes on next row
    changeflag = 0 'Variable to indicate if carrier change detected, flag reset
    If Cells(i, CarrierCol) <> Cells(i + 1, CarrierCol) Then
        changeflag = 1
    End If

    'Insert row if carrier changing or 5 rows complete
    If RowCount >= 5 Or changeflag = 1 Then
        Rows(i + 1).EntireRow.Insert
        i = i + 1 'Increment so that the loop picks up at the right spot on the next iteration
        RowCount = 0 'Reset row counter
    End If

    'Increment loop counter
    i = i + 1

Wend

MsgBox ("Separated rows until blank was found at row " & i - 1 & ".")

End Sub

Answer 2

您可以避免循环利用 helper 列（在下面的示例中为C列）：

Sub InsertRows()
    With Range("A2", Cells(Rows.Count, "A").End(xlUp)).Offset(, 4)
        With .Offset(1).Resize(.Rows.Count - 1)
            .FormulaR1C1 = "=IF(RC2<>R[-1]C2,1,"""")"
            .Value = .Value
            .SpecialCells(xlCellTypeConstants).EntireRow.Insert
        End With
        .FormulaR1C1 = "=IF(RC2="""",0,IF(RC1<>R[-1]C1,IF(R[-1]C=5,1,R[-1]C+1), R[-1]C))"
        .Value = .Value
        .Replace what:=5, replacement:=""
        .Resize(.Rows.Count - 1).SpecialCells(xlCellTypeBlanks).Offset(1).EntireRow.Insert
        .ClearContents
    End With
End Sub

，您只需将.Offset(, 2)更改为其他.Offset(, n)

，即可根据需要更改 helper 列

基于多单元格逻辑插入新行

2 个答案: