在数据点更改后插入行

时间:2012-05-10 17:34:47

标签: excel vba excel-vba

我有一个如下所示的数据集:

This1    GH
This2    GH
This3    GH
This4    BR
This5    BR
This6    VB

当数据点改变时,即“GH”到“BR”我希望excel插入换行符。这样最终的数据就像这样。

This1    GH
This2    GH
This3    GH

This4    BR
This5    BR

This6    VB

知道如何做到这一点?我认为循环的负迭代会起作用。但我不知道在这种情况下excel如何处理行操作。

3 个答案:

答案 0 :(得分:2)

假设您的电子表格没有数千行,您可以使用此(快速和脏)代码:

Sub doIt()

  Dim i As Long

  i = 2
  While Cells(i, 1) <> ""
    If Cells(i, 2) <> Cells(i - 1, 2) Then
      Rows(i).Insert
      i = i + 1
    End If
    i = i + 1
  Wend

End Sub

答案 1 :(得分:2)

最快的方法(经过测试和测试

Option Explicit

Sub Sample()
    Dim aCell As Range, bCell As Range
    Dim ExitLoop As Boolean

    With Sheets("Sheet1")
        .Columns("A:B").Subtotal GroupBy:=2, Function:=xlCount, TotalList:=Array(2), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True

        Set aCell = .Cells.Find(What:=" Count", LookIn:=xlValues, _
                     LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                     MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell
            .Rows(aCell.Row).ClearContents
            Do While ExitLoop = False
                Set aCell = .Cells.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    .Rows(aCell.Row).ClearContents
                Else
                    ExitLoop = True
                End If
            Loop
        End If

        .Cells.RemoveSubtotal
    End With
End Sub

我假设第1行有标题。

MACRO IN ACTION

enter image description here

答案 2 :(得分:1)

除了上面'慢'的excel问题,别忘了禁用application.screenupdating,它会提高5000%的任何宏的速度

Sub doIt()
  Application.ScreenUpdating = False
  Dim i As Long

  i = 2
  While Cells(i, 1) <> ""
  If Cells(i, 1) <> Cells(i - 1, 1) Then
     Rows(i).Insert

     i = i + 1
  End If
  i = i + 1
 Wend
 Application.ScreenUpdating = True
End Sub