如果I+2包含某些文本，则插入行

Question

所以我有一个excel工作表，可以有5-1500行的任何地方。大多数行都有: 1)标题行，2)患者信息，3)空白行。然后它会重复。有些行有1)标题行，2)患者信息，3)附加患者信息，4)空白行。如果第3行有信息，我需要在第2行和第3行之间插入一行。这有意义吗？示例：

1-账号-患者姓名-dr姓名-服务日期

2-123456-米老鼠-唐老鸭-1/4/19

3-(此行都是空白的)

或者可以是这样的：

1-账号-患者姓名-dr姓名-服务日期

2-123456-米老鼠-唐老鸭-1/4/19

3-123456-米老鼠-唐老鸭-1/4/19

4-(此行都是空白的)

然后，这种相同的格式在整个工作表中重复，当然会有不同的信息。我需要的是，如果行3有任何信息，然后在拖拽2和3之间插入一行，但如果行3是空的，则跳到下一组。

这是我到目前为止所用的代码，但不管是什么，它都是每隔一行添加一行。

Sub Macro()
Dim lastRow As Integer
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.count).Row
Dim I As Long
For I = 6 To lastRow
If Cells(I + 2, 9).Text <> "" Then
Rows(I + 1).EntireRow.Insert Shift:=xlDown
lastRow=lastRow+1

End If
Next I
End Sub

Answer 1

正如@BruceWayne在评论中所述，当插入或删除行、列或单元格时，向后迭代是很有帮助的。For-Next循环的Step参数允许您定义迭代的方式。默认为Step 1。因此，不是从I = 6 to lastRow迭代，而是尝试

Dim lastRow As Long
Dim i As Long
lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For i = lastRow To 6 Step -1
    If Cells(i - 1, 9).Text <> "" And Cells(i, 9).Text <> "" Then
        Rows(i).EntireRow.Insert Shift:=xlDown
    End If
Next i

如果当前单元格及其上方的单元格都包含数据，这将在当前迭代中插入一行。

值得注意的是，如果要迭代到第1行，上面的If语句将引发一个错误，但您永远不需要这样做。

编辑：

如果只需要在患者信息和其他患者信息之间添加一行，则需要找到一段可一致识别的数据，将其作为条件添加到If语句中。

Answer 2

试一试。

自定义变量以满足您的需要

Sub InsertRows()

    ' Define object variables
    Dim rangeEval As Range
    Dim currentCell As Range

    ' Define other variables
    Dim sheetName As String
    Dim rowCounter As Integer

    ' >>>> Customize this
    sheetName = "Sheet1"

    ' Initialize the used range in column A ' Change the number in .Columns(1) to use another column
    Set rangeEval = ThisWorkbook.Worksheets(sheetName).UsedRange.Columns(1)


    ' Loop through each cell in range
    For Each currentCell In rangeEval.Cells

        ' We use this counter to check if we are every third row
        rowCounter = rowCounter + 1

        ' If this is the third row and there is something in the cell, insert one row
        If rowCounter Mod 3 = 0 And currentCell.Value <> vbNullString Then

            currentCell.EntireRow.Insert

        ' Reset the counter if there is nothing in the cell
        ElseIf currentCell.Value = vbNullString Then

            rowCounter = 0

        End If

    Next currentCell


End Sub