基于多单元逻辑插入新行

Posted 2023-03-27

【中文标题】基于多单元逻辑插入新行

【英文标题】：Insert new Row based on Multiple Cell Logic

【发布时间】：2018-12-02 06:50:05

【问题描述】：

我对 VBA 很陌生，我已经尽我所能进行了搜索，但我仍然找不到答案。我需要编写一个宏，它将根据多个条件插入新行。这些行必须是不超过 5 个的组，并由承运人分隔。但如果一个 Container 是重复的，它会被计为 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

【问题讨论】：

您说“行必须在不超过 5 的组中”，但我在您的示例中看到两组六行。你能确认哪个是正确的吗？edit你的问题相应地？

"如果一个容器在重复，它算作 1 行。"重复必须在下一行还是可以在列中的任何位置？如果重复不止一次会怎样？

任何重复都会被组合在一起。但是，它可能超过 1。因此可能有 4 行具有相同的 Container/Carrier 需要被视为 1。

【参考方案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

【参考方案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

您可以根据需要更改 helper 列，只需将.Offset(, 2) 更改为其他.Offset(, n)