Question

我正在努力完成两件事; 1）基于顺序模式插入行（和A1中的数字）2）在插入行的其余列中插入字符串值“NA”。我正在使用下面的脚本，第1部分有效，但第2部分在所有列中都放置了“NA”，而不是工作表中使用的是什么。以下是数据样本：

2001    A   A   A
2002    A   A   A
2004    A   A   A
2005    A   A   A

代码应在2002年之后插入2003年，其中“NA”列于B列：D

这是我目前正在使用的脚本：

Sub test()
Dim i As Long, x, r, cell, CRange As Range
Dim InputValue As String
InputValue = "NA"
'test for sequential number
For i = Range("a" & Rows.Count).End(xlUp).Row To 2 Step -1
    x = Cells(i, 1) - Cells(i - 1, 1)
    If x > 1 Then
        Rows(i).Resize(x - 1).Insert
    End If
Next
'insert row if not sequential
For Each r In Range("a1", Range("a" & Rows.Count) _
    .End(xlUp)).SpecialCells(4).Areas
    With r.Cells(1).Offset(-1)
        .AutoFill .Resize(r.Rows.Count + 1), 2
    End With
        'Test for empty cell. If empty, fill cell with value given
        For Each cell In Selection
            If IsEmpty(cell) Then
            cell.Value = InputValue
            End If
        Next
Next
End Sub

Answer 1

您的范围仅在A栏中，即您的年份。因此，当它选择一个空单元格时，就不会有任何空单元格。您可以更改为：

For Each r In Range("a1", Range("a" & Rows.Count) _
.End(xlUp)).SpecialCells(4).Areas
With r.Cells(1).Offset(-1)
    .AutoFill .Resize(r.Rows.Count + 1), 2
End With
    'Test for empty cell. If empty, fill cell with value given
'Change comes in under this comment.
    For Each cell In Range("a1", Range("d" & Rows.Count) _
.End(xlUp))
        If IsEmpty(cell) Then
        cell.Value = InputValue
        End If
    Next
Next

关键是第二个循环中的列更改，可以根据需要进行更改。

Answer 2

仅使用一个循环插入行，然后使用NA填充新空白并重新创建数字序列：

Sub tgr()

    Dim rngNew As Range
    Dim rIndex As Long
    Dim lDifference As Long

    For rIndex = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        lDifference = Cells(rIndex, "A").Value - Cells(rIndex - 1, "A").Value
        If lDifference > 1 Then
            Rows(rIndex).Resize(lDifference - 1).Insert
            Select Case (rngNew Is Nothing)
                Case True:  Set rngNew = Rows(rIndex).Resize(lDifference - 1)
                Case Else:  Set rngNew = Union(rngNew, Rows(rIndex).Resize(lDifference - 1))
            End Select
        End If
    Next rIndex

    Intersect(Range("A1").CurrentRegion.EntireColumn, rngNew).Value = "NA"

    With Range("A2", Cells(Rows.Count, "A").End(xlUp))
        .Formula = "=A1+1"
        .Value = .Value
    End With

End Sub

Answer 3

如果在A栏中的年份之间缺少不超过一年的时间：

'Go through each cell in column A that has values
For Each cl In Range("A2", Cells(Rows.Count, "A").End(xlUp))
  'If not expected, then...
  If cl.Value <> (cl.Offset(-1, 0).Value + 1) Then
    'Insert the new row
    cl.Insert shift:=xlShiftDown
    'Put an expected value in the new blank row, column A
    cl.Offset(-1, 0).Value = (cl.Offset(-2, 0).Value + 1)
    'Fill in "NA" across the other cells
    Range(cl.Offset(-1, 1), cl.Offset(-1, 3)).Value = "NA"
  End If
Next

Range(cl.Offset(-1, 1), cl.Offset(-1, 3)).Value = "NA"填写“NA”。您可以使用Range.Value一次填充多个单元格。

插入行后VBA插入字符串

3 个答案: