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

Question

作为在这里寻求帮助的大多数人，我是 VBA 的新手，但我认为无法使用常规公式解决我的问题，因此解释：

我在col里有几套物资代码。 A从小到大排序，它们对应的数据在B到Y列。我需要的是在每组代码下面添加一定数量的空白行，等于col中的对应值。 Z，下面是"before"

的例子

 - 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"

我在这里的一篇帖子中找到了针对类似问题的建议（它在每组数据后添加了一行）但我还不能充分掌握 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

结束子

干杯！

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

Add amount of blank rows based on cell value

vba

excel

cells