データ検索後の上書き

質問

データシートに記載がある社員番号を入力フォームに入力し特定の社員データを検索するマクロを下記にて組みました。検索抽出された社員データを直接一部修正入力してもとの社員データヘ上書き処理をする(データによって修正しないこともあり)場合のマクロをご教示願います。

Sub ボタン1_Click()
Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
tmpInt = Worksheets("入力フォーム").Range("C4").Value
motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11")

Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole)
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
End Sub

回答No.2

rivoisu · ベストアンサー

まずあなたのコードを見ます。
Sub ボタン1_Click()
　　Dim tmpInt As Integer, motoHani(), myRng As Range, i As Integer
　　tmpInt = Worksheets("入力フォーム").Range("C4").Value
　　’入力フォームシートのC4の値をtmpintに代入（たぶん社員ID)
　　motoHani = Array("C6", "C7", "C8", "F8", "C10", "C11")
　　'入力フォーム上の対象セルをmotohaniｍにセット
　　Set myRng = Range("社員テーブル").Columns(1).Find(tmpInt, LookAt:=xlWhole)
　　'社員テーブル上のtmpint(社員ID）の一致するセルを取得
　　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
　　'見つかったら入力フォーム上の対象セルにその行の値を代入
End Sub

で目的の処理は
入力フォーム上のC4セルで社員テーブルを検索
見つかったら入力フォーム上の対象セルをその行に代入
つまりセルを見つけるまでは一緒で代入が反対になるだけでいいと思います。
　　　　Range(motoHani(i)).Value = myRng.Offset(0, i + 1)
を
　　　　 myRng.Offset(0, i + 1)=Range(motoHani(i))
に変えたSubを作ればOKだと思います。

おまけ
新規追加のときは最後の列を見つけて同じ代入処理でできますがこのときは社員IDも代入することを忘れずに

テストしてませんがたぶんこれでいいと思います。
うまくいかなかったらまた書いてください。

お礼

ご回答ありがとうございます。おかげさまで希望どおりうごきました。

回答No.1

rivoisu

質問は何ですか？
どこかエラーになるとか動作が思いと違うとか

補足

説明不足で失礼しました。
検索後に抽出データに対し修正入力をおこなった場合、そのままもとのデータに上書きされるような別のマクロボタンなどを追加したく思います。