vba 在数据点更改后插入行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/10539346/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
insert rows after a data point changes
提问by franklin
I have a data set that looks like this:
我有一个看起来像这样的数据集：
This1 GH This2 GH This3 GH This4 BR This5 BR This6 VB
when the data point changes, i.e. "GH" to "BR" I want excel to insert a line break. so that the finalized data looks like this.
当数据点更改时，即“GH”到“BR”我希望excel插入换行符。这样最终的数据看起来像这样。
This1 GH This2 GH This3 GH This4 BR This5 BR This6 VB
any idea how this would be done? i think that a negative iterating for loop would work. but i don't know how excel would handle row manipulation in this case.
知道如何做到这一点吗？我认为循环的负迭代会起作用。但我不知道在这种情况下 excel 将如何处理行操作。
采纳答案by Siddharth Rout
The fastest way to do it (TRIED AND TESTED)
最快的方法（久经考验）
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
I am assuming that Row 1 has headers.
我假设第 1 行有标题。
MACRO IN ACTION
宏在行动
回答by assylias
Assuming your spreadsheet does not have thousands of lines you can use this (quick and dirty) code:
假设您的电子表格没有数千行，您可以使用这个（快速而肮脏的）代码：
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
回答by Langeleppel
In addition to above 'slow' excel problem, don't forget to disable the application.screenupdating , it will improve speed in any macro with 5000%
除了上面的“慢”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
