VBAで検索後、行番号取得し上書き保存
Excel2002です。入力シートと一覧シートを作成し、入力シートの入力フォームに入力すると一覧シートの表の最終行に新規で転記されるようにしました。
また、入力シートでカタカナ検索すると、入力フォームに表示され、そのデータがある行番号をA1セルに取得するまではできました。検索表示したデータを修正し、取得した行番号に上書きしたいのですが、どうしても2行下に上書きされてしまいます。
取得行番号 980 → 上書きされる行番号 982
そのまま980行にデータを上書きしたい場合、どうしたらいいのでしょうか？
困っています。よろしくお願い致します。
--------------------------------------------------------------
Sub 新規レコード転記2()
Dim motoSht As Worksheet, sakiSht As Worksheet, sakiTbl As Range, sakiRng As Range, i As Long
Dim lastRec As Range, newRec As Range
Dim motoHani()
Application.ScreenUpdating = False '画面の更新をストップ
Set sakiSht = Sheets("一覧")
motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
Set sakiRng = sakiSht.Range("B" & Rows.Count).End(xlUp).Offset(1)
For i = 0 To UBound(motoHani)
sakiRng.Offset(0, i).Value = motoSht.Range(motoHani(i)).Value
motoSht.Range(motoHani(i)).MergeArea.ClearContents
Next
MsgBox "入力を完了しました。"
End Sub
Sub 情報検索()
Dim tmpInt As String, motoHani(), myRng As Range, i As Integer
'変数の宣言
tmpInt = Sheets("入力").Range("D4").Value
'検索する文字列を取得
motoHani = Array("C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
'転記する位置を設定
Set myRng = Range("顧客情報").Columns(1).Find(tmpInt, LookAt:=xlWhole)
'顧客情報の1フィールド目を対象に検索
If myRng Is Nothing Then
MsgBox "該当するレコードはありませんでした"
Exit Sub
End If
'検索値が無かった場合は処理を抜ける
For i = 0 To UBound(motoHani)
Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
Next
'検索値が見つかったセルを元にレコードの情報を転記
'検索した行番号をA1セルに保存
Range("A1") = myRng.Row
End Sub
Sub 修正して上書き()
Dim no As Long, motoHani(), i As Integer
no = Range("A1")
motoHani = Array("D4", "C6", "I6", "C7", "J7", "C8", "C9", "C10", "H10", "C11", "I11", "C12", "E12", "H12", "J12", "C14", "C13", "E13", "H13", "J13", "C15", "C16")
For i = 0 To UBound(motoHani)
Range("顧客情報").Cells(no, i + 1) = Range(motoHani(i)).Value
Next
MsgBox "修正しました。"
End Sub
---------------------------------------------------------------
お礼
回答ありがとうございます。 まだ、VBAに不慣れなのでSetの使い方が、十分に分かっていませんでした。 早速、Setを消して、実行してみたいとおもいます。