Question

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

我在col中有几套物资代码。从最小到最大排序，它们在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"

我在其中一个帖子中找到了类似问题的建议（它在每组数据后添加了一行）但我还不能完全掌握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

首先需要确定哪一个是包含唯一值的最后一行，因为在此行之后插入空白时。我添加了一个额外的列＆＃34; C＆＃34;指示该行是否是最后一行。

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

End Sub

干杯！

根据单元格值

3 个答案: