ここから本文です

ユーザーフォームで検索したデータを上書き

vivienne_3225さん

2011/8/1614:33:10

ユーザーフォームで検索したデータを上書き

シート「DB」よりユーザーフォームで検索→結果データを修正し、
「DB」に上書きしたいのですが、どのようにしたら良いのかわかりません。

以下は検索のコードです。

Private Sub 検索_Click()

Dim SerchKey As String
Dim SerchArea As Range

'検索語入力
SearchKey = Application.InputBox( _
Prompt:="工事コードを入力して下さい", Type:=2)
If SearchKey = "" Or SearchKey = "False" Then
Exit Sub
End If

'検索範囲
Set SearchArea = Sheets("DB").Range("A:A")

'検索処理(引数:LookAt に xlWhole で完全一致
Set FoundCell = SearchArea.Find( _
What:=SearchKey, _
SearchOrder:=xlByRows, _
LookAt:=xlWhole, _
MatchCase:=False)
'工事コードが無い場合の処理
If FoundCell Is Nothing Then
MsgBox "該当するデータはありません", vbCritical
GoTo ExitHandler
End If
'見つかった場合の処理
With FoundCell
Me.コード.Value = .Value
Me.契約.Value = .Offset(0, 1).Value
Me.氏名.Value = .Offset(0, 2).Value
Me.月.Value = .Offset(0, 3).Value
Me.現場名称.Value = .Offset(0, 4).Value
Me.地番.Value = .Offset(0, 5).Value
Me.住所.Value = .Offset(0, 6).Value
Me.支店.Value = .Offset(0, 7).Value
Me.契約選択.Value = .Offset(0, 8).Value
Me.営業.Value = .Offset(0, 9).Value
Me.立会.Value = .Offset(0, 10).Value
Me.決済.Value = .Offset(0, 11).Value

End With

ExitHandler:
Set SearchArea = Nothing
Exit Sub
End Sub

上記より色々なサイトを見て

Private Sub 修正_Click()
Dim x
With Sheets("DB")
x = Application.Match(コード.Value, .Columns("a"), 0)
If Not IsError(x) Then
.Cells(x, 1).Resize(, 11).Value = Array(契約.Value, 氏名.Value, 月.Value, 現場名称.Value, 地番.Value, 住所.Value, 支店.Value, 契約選択.Value, 営業.Value, 立会.Value, 決済.Value)

Else
MsgBox "該当データなし"
End If
End With
End Sub

というコードを作成しましたがうまくいきません。
どこがダメなのかご教授頂けば幸いです。
宜しくお願い致します。

閲覧数:
1,347
回答数:
1
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

hige_082さん

2011/8/1616:21:29

vivienne_3225さん

検索_Clickの処理内容を理解していれば簡単です
検索_Clickと同じ処理をすればよいです
検索_Clickの検索キーに「Me.コード.Value」を設定して
見つかった場合は
Me.契約.Value = .Offset(0, 1).Valueを
.Offset(0, 1).Value = Me.契約.Valueとするだけですよ

修正例
Private Sub 修正_Click()
Dim SerchKey As String
Dim SerchArea As Range

'検索語入力
SearchKey = Me.コード.Value
If SearchKey = "" Or SearchKey = "False" Then Exit Sub

'検索範囲
Set SearchArea = Sheets("DB").Range("A:A")

'検索処理(引数:LookAt に xlWhole で完全一致
Set FoundCell = SearchArea.Find( _
What:=SearchKey, _
SearchOrder:=xlByRows, _
LookAt:=xlWhole, _
MatchCase:=False)

'工事コードが無い場合の処理
If FoundCell Is Nothing Then
MsgBox "該当するデータはありません", vbCritical
Else

'見つかった場合の処理
With FoundCell
.Offset(0, 1).Value = Me.契約.Value
.Offset(0, 2).Value = Me.氏名.Value
.Offset(0, 3).Value = Me.月.Value
.Offset(0, 4).Value = Me.現場名称.Value
.Offset(0, 5).Value = Me.地番.Value
.Offset(0, 6).Value = Me.住所.Value
.Offset(0, 7).Value = Me.支店.Value
.Offset(0, 8).Value = Me.契約選択.Value
.Offset(0, 9).Value = Me.営業.Value
.Offset(0, 10).Value = Me.立会.Value
.Offset(0, 11).Value = Me.決済.Value
End With
End If
Set SearchArea = Nothing
End Sub

検索_Clickを元に必要最低限しか修正していません
参考まで

質問した人からのコメント

2011/8/18 11:47:59

成功 無事に解決しました。本当にありがとうございました。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

5文字以上入力してください

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。