VBA Вставить строку после вставки строки

Question

Я пытаюсь выполнить две вещи; 1) вставьте строки (и число в A1) на основе последовательного шаблона 2) вставьте строковое значение «NA» в остальные столбцы вставленной строки. Я использую сценарий ниже, часть 1 работает, но часть 2 ставит «NA» во всех столбцах, а не в том, что используется в листе. Вот пример данных:

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

код должен вставить 2003 ПОСЛЕ 2002 "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

Если не более чем один год не хватает в то время между годами в колонке А :

'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.