1

私は2つのことを達成しようとしています。1) シーケンシャル パターンに基づいて行 (および A1 の数値) を挿入します。2) 挿入された行の残りの列に "NA" の文字列値を挿入します。以下のスクリプトを使用しています。パート 1 は機能しますが、パート 2 では、ワークシート内で使用されているものではなく、すべての列に「NA」を入れています。データのサンプルを次に示します。

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

コードは、列 B:D に「NA」を付けて 2003 AFTER 2002 を挿入する必要があります。

現在使用しているスクリプトは次のとおりです。

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
4

3 に答える 3

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

重要なのは、必要に応じて変更できる 2 番目のループの列の変更です。

于 2013-09-17T17:45:36.703 に答える
0

列 A の年の間に欠落している年が 1 年以下の場合:

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

于 2013-09-17T18:09:20.373 に答える
0

ループを 1 回だけ使用して行を挿入し、新しい空白を埋めて、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
于 2013-09-17T18:02:37.030 に答える