プロが教える店舗&オフィスのセキュリティ対策術

Excel vba で入力シート、データシートを作成し登録・検索・更新ボタンを作りました。
B2に年月、B3に氏名、B4にフリガナを入力し登録ボタンを押すとデータシートに登録されます。
年月、氏名を入力し検索をかけるとデータシートからヒットしたデータが入力シートに反映されるようになっています。
今後項目を増やしデータを変更したら更新ボタンで上書き出来る様にしたいのですが
更新ボタンの内容がデータシートの中に氏名がヒットすると年月がヒットしていなくても
更新メッセージが出てしまい実際にはデータが更新されず入力した内容が消えてしまいます。
氏名、年月共にヒットするデータがなければ更新出来るデータがありません。とメッセージが出て
内容も消えずそのままの状態になるようにするにはどうしたらいいか教えて下さい。
よろしくお願いいたします。

Private Sub CommandButton3_Click()
If Range("b2").Value = "" Then
MsgBox "年月を入力してください。"
Exit Sub
End If

If Range("b4").Value = "" Then
MsgBox "情報が不十分です。" & vbCrLf & "正しく入力してください。", vbExclamation
Exit Sub
End If
Dim fname As String
Dim fdate As Date
Dim rng As Range
Dim frg As Range
Dim fadd As String
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim f As Integer
Dim g As Integer
Dim h As Integer
Dim i As Integer

Application.ScreenUpdating = False
fname = Range("B3")
fdate = Range("B2")



With Worksheets("データ")
Set rng = .Range("B2:B" & .Cells(Rows.Count, 1).End(xlUp).Row) 'データシートの名前欄B2から最終行までを取得
End With

With rng
Set frg = .Find(What:=fname, LookIn:=xlValues, LookAt:=xlWhole) 'rngで取得した範囲の中から入力シートのB3の値と完全一致の値を検索
If Not frg Is Nothing Then '検索結果があった場合
fadd = frg.Address 'ヒットしたセルのアドレスを格納
Do
If frg.Offset(0, -1) = fdate Then 'ヒットしたセルと同じ行のA列の日付が入力シートのE2の日付と同じ場合
frg.Offset(0, -1) = Cells(2, 2)
frg.Offset(0, 0) = Cells(3, 2)
frg.Offset(0, 1) = Cells(4, 2)
End If

Set frg = .FindNext(frg) '二個目の検索結果
If frg Is Nothing Then Exit Do '二個目がなかったらループ抜ける
Loop Until frg.Address = fadd '二個目が最初のアドレスと同じになるまで
End If
Else
MsgBox "更新先にデータが見つかりません。" & vbCrLf & "氏名と年月を確認してください。", vbExclamation
End If
End With

If Range("B2").Value = "" Or Range("B3").Value = "" Then
MsgBox "氏名と年月を入力してください。", vbExclamation
Exit Sub
End If


Range("b4").ClearContents


Worksheets("入力").Select
MsgBox "情報が更新されました。", vbInformation
Sheets("データ").Cells.WrapText = False
With Sheets("データ")
.Range("b1").Sort Key1:=.Range("c1") _
, Order1:=xlAscending _
, Header:=xlYes
End With

Application.ScreenUpdating = True
End Sub

質問者からの補足コメント

  • 返事が遅れてすみませんm(__)m
    Elseの前のEnd Ifがいらなかったです。
    そこを削除すれば正常に動きます。
    よろしくお願い致します。

    No.3の回答に寄せられた補足コメントです。 補足日時:2020/11/02 12:05

A 回答 (4件)

このコードって、y.u-kiさんがご自身で書いたんですか?ちょっと取っ散らかった感じがしますね~。


事前にやるべきチェック処理。ヒットした時の処理。ヒットしなかった時の処理が、あちこちに散らばっているようで、何をどうするのが正解なのか確信がもてませんでした。
手っ取り早く直すのであれば、下記のIF文の中に、ヒットした時の処理を詰め込んで、Exit Subが一番簡単なような気がしますが・・・。
しかし、先ほど述べた通り、ヒットした時に何がしたいのか分かんなかったので、サンプルのコードが書けませんでした。申し訳ないですが、今回はアドバイスだけにさせて下さい。

If frg.Offset(0, -1) = fdate Then 'ヒットしたセルと同じ・・・
  frg.Offset(0, -1) = Cells(2, 2)
  frg.Offset(0, 0) = Cells(3, 2)
  frg.Offset(0, 1) = Cells(4, 2)
  ※この辺にヒットした時の処理を全部移植して、Exit Subする※
End If
※IFの後は、ヒットしなかった場合の処理を書く※
    • good
    • 0

私のやり方が悪いのかもしれませんが、掲示されているコードをそのまま貼って実行すると「コンパイルエラー。

ELSEに対応するIFがありません」って、出ちゃうんですけど、y.u-kiさんのExcelはエラーにならないのでしょうか?
エラーになるのは、下記の”ELSE”です。

Else
MsgBox "更新先にデータが見つかりません。"
この回答への補足あり
    • good
    • 0

それ VBAでやる必要あるのか疑問



そもそも それらすべて
エクセルの機能で出来るじゃん というハナシ
    • good
    • 0

どう言う意味ですか?

    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!