値が存在しない場合のエラー

値が存在しない場合のエラー

私は、"CPNEC" だけでなく、異なる値に対して、1 つのサブで以下のコードを何度も使用しています。スプレッドシートにその値の範囲がある場合は正常に動作しますが、値が存在しない場合はその範囲を超えてしまいます。これは、毎月使用したいルーチンですが、データに特定の値がまったく存在しない場合があるため、次の値に移動できるようにする必要があります。どなたか助けていただけませんか。

Sub SelectCPNEC()
    ' Figure out where the "CPNEC" data starts.
    For nRow = 1 To 65536
    If Range("A" & nRow).Value = "CPNEC" Then
    nStart = nRow
    Exit For
    End If
    Next nRow

    ' Figure out where the "CPNEC" data ends.
    For nRow = nStart To 65536
    If Range("a" & nRow).Value <> "CPNEC" Then
    nEnd = nRow
    Exit For
    End If
    Next nRow
    nEnd = nEnd - 1

    'Select the range required

    Range("A" & nStart & ":G" & nEnd).Select

    'Now copy and paste into the right worksheet

    Selection.Copy
    Application.Goto ActiveWorkbook.Sheets("CPNEC").Cells(1, 1)
    ActiveSheet.Paste

End Sub

答え1

一致する値が存在しない場合は、nStartのデフォルト値が保持されます0。これにより、この行でエラーが発生します。

If Range("a" & nRow).Value <> "CPNEC" Then

は有効な範囲参照ではないためですA0。この問題を回避するには (そして不要なループを回避するには)、nStart = 0最初のループの後に条件チェックを追加します。ゼロの場合はサブを終了し、それ以外の場合は続行します。これにより、一致が見つからない場合にコードが停止するエラーを回避できます。

Sub SelectCPNEC()
    ' Figure out where the "CPNEC" data starts.
    For nRow = 1 To 65536
    If Range("A" & nRow).Value = "CPNEC" Then
    nStart = nRow
    Exit For
    End If
    Next nRow

    If nStart > 0 Then
        ' Figure out where the "CPNEC" data ends.
        For nRow = nStart To 65536
        If Range("A" & nRow).Value <> "CPNEC" Then
        nEnd = nRow
        Exit For
        End If
        Next nRow
        nEnd = nEnd - 1

        'Select the range required

        Range("A" & nStart & ":G" & nEnd).Select

        'Now copy and paste into the right worksheet

        Selection.Copy
        Application.Goto ActiveWorkbook.Sheets("CPNEC").Cells(1, 1)
        ActiveSheet.Paste
    End If
End Sub

答え2

Excellll が説明しています。ただし、for ループを適切に処理できるため、各セルで文字列を検索し、マクロがそれを見つけたら、行全体を適切なワークシートにコピーすることもできます。値が存在しない場合はエラーは発生しません。

For Each cell In Range("A1: A65536")
    If cell.Value = "CPNEC" Then
        cell.EntireRow.Copy Workbooks.Open("otherWorkbook.xls").Sheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0)
    End If
Next cell

セル「A1」とセル「A2」には、列タイトルなどの情報が含まれているはずです。情報を貼り付けるための最初の空の行を見つけます .End(xlDown).Offset(1,0)

関連情報