0

我对 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
4

2 回答 2

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
于 2018-06-22T20:05:13.377 回答
1

您可以避免循环利用辅助列（在我的以下示例中为 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)

于 2018-06-23T10:43:30.090 回答