根据单元格值添加空白行数量

由于大多数在这里寻求援助，我是新来的VBA，但我认为是没有办法解决我的问题与传统的公式，因此解释：

我有几套materiel代码。 从最小到最大sorting，它们对应的数据在列B到Y中。我需要的是在每个代码下面添加一个空白行，等于col中对应的值。 Z，下面是“之前”的例子

- Col. A ---- Col. Z - 65504927 - 3 - 65504927 - 3 - 65504927 - 3 - 65505044 - 1 - 65505044 - 1 - 65505044 - 1 - 65505151 - 0 - 65505151 - 0 - 65505297 - 2 - 65505297 - 2 

之后 –

 - Col. A ---- Col. Z - 65504927 - 3 - 65504927 - 3 - 65504927 - 3 - "blank row" - "blank row" - "blank row" - 65505044 - 1 - 65505044 - 1 - 65505044 - 1 - "blank row" - 65505151 - 0 - 65505151 - 0 - 65505297 - 2 - 65505297 - 2 - "blank row" - "blank row" 

我在其中的一个post中发现了一个类似的问题（在每个数据集之后添加了一行），但是我还不能掌握足够的VB架构来进行修改，所以我非常感谢您的帮助，谢谢提前。

Answer 1

以下为我工作：

 Sub add_blank_rows() Dim Awsh As Worksheet Dim ARow As Range Dim AColumn As Range Dim UsedRange As Range Dim to_insert As Integer Dim count As Integer Set Awsh = ActiveSheet Set UsedRange = Awsh.UsedRange Set AColumn = Range(Cells(1, 26), Cells(UsedRange.End(xlDown).Row, 26)) For Each ARow In AColumn If Not ARow.Offset(1, 0) = ARow And _ IsNumeric(ARow.Offset(1, 0)) And _ IsNumeric(ARow) Then to_insert = ARow For count = 1 To to_insert ARow.Offset(1).EntireRow.Insert Next count End If Next ARow End Sub 

Answer 2

首先需要确定哪一个是包含唯一值的最后一行，因为在该行插入空白后。 我已经添加了一个额外的列“C”来表明行是否是最后一个。

 Sub AssignLast() Dim i As Long For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row If i = 1 Then If Range("A" & i).Value <> Range("A" & i + 1).Value Then Range("C" & i).Value = 1 End If Else If Range("A" & i).Value = Range("A" & i - 1).Value And _ Range("A" & i).Value <> Range("A" & i + 1).Value Then Range("C" & i).Value = 1 End If End If Next i End Sub Sub InsertBlankRows() Dim i As Long For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row If Range("C" & i).Value = 1 Then Rows(i + 1 & ":" & i + Range("B" & i).Value).Insert Shift:=xlDown End If Next i End Sub 

Answer 3

非常感谢你的帮助，你们在这里有一个很棒的，有帮助的社区！

特别感谢@ sgp667，这工作就像一个魅力：

 Sub add_blank_rows() Dim Awsh As Worksheet Dim ARow As Range Dim AColumn As Range Dim UsedRange As Range Dim to_insert As Integer Dim count As Integer Set Awsh = ActiveSheet Set UsedRange = Awsh.UsedRange Set AColumn = Range(Cells(1, 26), Cells(UsedRange.End(xlDown).Row, 26)) For Each ARow In AColumn If Not ARow.Offset(1, 0) = ARow And _ IsNumeric(ARow.Offset(1, 0)) And _ IsNumeric(ARow) Then to_insert = ARow For count = 1 To to_insert ARow.Offset(1).EntireRow.Insert Next count End If Next ARow 

结束小组

干杯!