0

ExcelVBAコードの改善策を教えて下さい。
Intersectメソッドは失敗しましたエラーが時々出ます。 Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' 別のセルを値を設定しても割り込みが起こらないようにする
Call コード入力処理(Target)
Application.EnableEvents = True
End Sub

Sub コード入力処理(入力セル As Range)
Dim 入力コード As Variant
Dim i As Integer

If 入力セル.Count <> 1 Then Exit Sub ' 行削除や複数項目入力は未対応
If Intersect(入力セル, Range("D14:D230")) Is Nothing Then Exit Sub ' コード入力以外は未対応
入力コード = 入力セル.Value
Do

If i <> 0 Then Intersect(入力セル.Offset(i).EntireRow, Columns("D")) = 入力コード - i
Intersect(入力セル.Offset(i).EntireRow, Columns("F")) = 品名取得(入力コード - i)
Intersect(入力セル.Offset(i).EntireRow, Columns("G")) = 規格取得(入力コード - i)
Intersect(入力セル.Offset(i).EntireRow, Columns("AF")) = 備考取得(入力コード - i)

If 品名取得(入力コード - i) = "" Then Exit Do ' コードエラー（空の時も）終了
i = i + 1
If (入力コード - i) Mod 10 = 0 Then Exit Do ' 下1桁0なら処理終了
Loop
End Sub

質問者が選んだベストソリューション

Yahoo!知恵袋 3916日前