• 締切済み

ユーザーフォームで別シートを検索できますか

現在エクセルのユーザーフォームを勉強中です。職員データとメモの二つのシートがあります。職員データシート上で職員コード番号で検索し検索画面を閉じるとデータを表示するユーザーフォームが表示されるように作成しました。ここまでは出来ました。これを、コード番号の検索でメモシートの職員番号も検索し該当する番号があれば行番号を取得(変数名:メモRow)無ければカーソルを最終行に移動。データ表示フォームに職員のデータとその職員のメモデータを表示するように、メモを書きたいときはメモ表示ボックスに記入。記入したデータをメモシートにも記入できるようにしたい。 出来ないこと (1)職員データシートの検索画面でメモシートを同時に検索したい (2)メモシートの行番号を変数に格納したい (3)該当番号がなければ最終行にカーソルを移動したい (4)職員データのフォームに記入したデータをメモシートに反映させたい わかる方どうぞ教えてください。 こんな風に作りました Private Sub 初期化_Click() Unload UserForm検索 UserForm検索.次へ.Enabled = False UserForm検索.Label1.Caption = "検索値を入れて検索ボタンを押してください。" UserForm検索.Show vbModeless End Sub Private Sub 検索_Click() Dim 検索値 As String '変数を宣言。 On Error GoTo errhandler 検索値 = TextBox1.Value If 検索値 = "" Then MsgBox "検索する語句を入れてください。" TextBox1.SetFocus 'TextBox1にカーソルを移動。 Else Cells.Find(What:=検索値, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False, MatchByte:=False).Activate 検索.Enabled = False 次へ.Enabled = True Label1.Caption = "次をさがすには「次へ」ボタンを押してください。" 'Label1のメッセージを変える。 errhandler: ' Select Case Err.Number Case 91 MsgBox "その検索値は存在しません。" End Select ' End If End Sub Private Sub 次へ_Click() Cells.FindNext(After:=ActiveCell).Activate End Sub Private Sub 閉じる_Click() Unload Me DATA.Show End Sub 以上検索画面 ※別シートの検索は可能ですか? 以下は表示画面(DATA) Option Explicit Private myRow As Long Private Sub btm検索_Click() Unload Me 'DATAフォームを非表示に。 UserForm検索.Show '検索フォームを表示 End Sub Private Sub btm前_Click() '前へボタン myRow = myRow - 1 GetData End Sub Private Sub btnCancel_Click() '終了を確認する If MsgBox("終了しますか?", vbYesNo, "確認") = vbYes Then Unload Me End If End Sub Private Sub btn次_Click() '次へボタン myRow = myRow + 1 GetData End Sub ※以下はデータ表示コマンドが続きます最後に Me.tab3資格1.Value = ActiveSheet.Cells(myRow, 111).Value Me.tab3資格2.Value = ActiveSheet.Cells(myRow, 114).Value Me.tab4メモ.Value = Worksheets("メモ").Cells(メモRow, 3).Value                              ↑                  表示できない、具体的に行数を入れると表示する! End Sub ※変数:メモRowをどこで宣言すれば?

みんなの回答

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.3

ご提示のコードを拝見しましたが、 フォームの詳細・目的の解釈しきれなかった部分もございます。 勝手な解釈を踏まえて作成しましたので、目的の動作になっていないかもしれませんが。 ご提示のコードをベースに一連の動作をするものを作成してみました。 参考になればと思います。 >※以下はデータ表示コマンドが続きます最後に >Me.tab3資格1.Value ~ .Cells(メモRow, 3).Value テキストボックスで表示されているのでしょうか? 詳細が分からなかったので後の項目追加、見た目重視で 勝手ながらリストビューコントロールを使用して作成しました。 ■(1)処理の流れ 「UserForm検索」フォームの表示  ↓ 検索値による職員シート、メモシートの検索  |  |・「次へ」で同じ検索値で他のセルへ対象が移る  ↓ 「閉じる」で「DATA」フォームの表示  |  |・検索された職員シートのデータがリストビューに表示  |・データを選択して「F2」キーで職員コードを変更可能  | (変更後、データリストを更新し、メモシートを再検索)  |・「検索」で「UserForm検索」へ戻る  |・「前へ」で「職員データ」の1行上のデータを表示  |・「次へ」で「職員データ」の1行下のデータを表示  |・「×」又は「キャンセル」で終了確認ダイアログの表示  ↓ 「メモに書込み」ボタンをクリック  |  |―→「メモ」シートに見つからない場合  | ・「職員データ」:見つかった行のメモを変更  | ・「メモ」:最終行に職員コード、氏名、メモを追加  ↓ 「メモ」シートに見つかった場合 ・「職員データ」:見つかった行のメモを変更 ・「メモ」:見つかった行のメモを変更 ■(2)前提条件 動作の前提条件として以下のようになっている必要があります。 ・シート名は「職員データ」「メモ」とする  (標準モジュールのSettingプロシージャで設定可能) ・両シートとも、1行目は項目名が入っている ・両シートとも、A列「職員コード」B列「氏名」C列「メモ」となっている ・「職員データ」のDG列(111列目)「資格1」DJ列(114列目)「資格2」とする  (この項目は増減することが出来ます。コード内のコメント参照) ・「メモ」に存在し、「職員データ」に存在しない「職員コード」は考慮していません ■(3)ユーザーフォームの作成 添付画像のような配置で「UserForm検索」と「DATA」フォームを作ります。 リストビューの追加方法は下記URLを参考に願います。 http://officetanaka.net/Excel/vba/listview/index.htm 上記ページの下部リンクより以下を参照してListView1をDATAフォームへ配置してください。  1.ListViewコントロールの組み込み  2.ListViewコントロールの配置 ■(4)標準モジュールの挿入 VBEの挿入→標準モジュールから標準モジュールを挿入してください。 ■(5)VBAコードの貼付 コードを全て記述すると文字数オーバとなるため、 クラウド(Doropbox)にアップロードしています。 (この提示方法が問題であれば数回の回答に分けてコードを投稿致します)  (1)標準モジュールに以下のコードを貼付   https://www.dropbox.com/s/qtl24d87bm730tf/Module1.txt?dl=0  (2)「UserForm1」に以下のコードを貼付   https://www.dropbox.com/s/pzzvjejhhgd7dgv/UserForm1.txt?dl=0  (3)「DATA」に以下のコードを貼付   https://www.dropbox.com/s/ppsnsn1g01lpges/DATA.txt?dl=0 ■(6)実行 標準モジュールの「search_form_view」を実行してください。 検索フォームが表示されるので、上記「■(1)処理の流れ」にそって 操作願います。

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.2

ご提示の(1)~(4)に対する回答を主としておりましたので、 目的の動作とそぐわない結果になっていました事お詫び申し上げます。 >(1)職員データ・メモ 両方のシートに職員番号がある場合。 >検索画面を閉じるとメモシート上にデータフォームが表示され >肝心の職員のデータが表示されない。 →Worksheets("職員データ").Activateを追加 ご提示の修正方法で良いと思います。 >(2)職員データにあってメモシートにない場合 >検索フォームの閉じるをクリックすると実行時エラー'1004' こちらでは再現できませんでした。 両シートとも、A列1~10行目に文字列で001~010の通し番号をいれた データのうちメモシートの数行だけ削除したデータでテストしています。 お手数ですが同じ状態のデータで再度エラーが発生するか確認願います。 >カーソルは最終の職員番号の位置に有り >→iカーソルはメモシートの最終の職員番号の下 Cells(Rows.Count, "A").End(xlUp).Offset(0, 1).Select とすることで最終行1行下を選択することが出来ます。 >ii閉じるボタンを押すと職員データシートに移り >メモ以外の職員のデータは表示したい おそらくDATAフォームの動作とおもわれますが、 こちらは詳細な作成を行っておらずNo1のようにメモRowの共有と、 値の設定方法についてのみの説明としておりました。 文字数制限により、次の投稿にてご提示の捕捉とご質問内容を 合わせたフォームを作成したものを投稿致します。 >iii当月のメモ内容をメモシートに書き込みたい。 >職員コード・氏名(これは職員データにあります)・メモ >を最終行に書き込みたい 「職員データ」「メモ」シート共に存在する場合は 両方のメモデータを入力ボックスの値で置き換え、 「メモ」シートに職員コードが見つからなければ 入力ボックスの値をメモの値としてメモシートの最終行+1行へ 職員コード、氏名、メモを追加するということでしょうか? 以上を踏まえて作成してみましたので、コードを次に投稿致します。 動作状態は添付画像のような形になります。

  • eden3616
  • ベストアンサー率65% (267/405)
回答No.1

ユーザーフォームの仕様がなかったため、 質問文・コードから適当に想定しています。 (ユーザーフォーム「DATA」は適当) 添付画像のような流れで、各モジュールに記述するコードを 下記「■(1)~(3)」に記載しています。 ・各プロシージャの頭には「▽」で説明をコメントしています ・新規で追加したコードには説明のコメントを入れています ご提示の問題に対する回答としては以下のようになります。 >(1)職員データシートの検索画面でメモシートを同時に検索したい  → ■(2)を参照:▼「メモ」シートをアクティブにして検索 >(2)メモシートの行番号を変数に格納したい  → ■(1)を参照:Public メモRow As Long  → ■(2)を参照:メモRow = 検索セル.Row >(3)該当番号がなければ最終行にカーソルを移動したい  → ■(2)を参照:Cells(Rows.Count, "A").End(xlUp).Select >(4)職員データのフォームに記入したデータをメモシートに反映させたい  → ■(3)を参照 不明な点があれば補足願います。 ■(1)新規に標準モジュールを挿入して記述 '▽ユーザーフォーム間で共通の広域変数を宣言 Public メモRow As Long ■(2)ユーザーフォーム「UserForm検索」へ記述 Private myRow As Long '▽新しくテキストボックスに入力されたらボタン状態をリセット Private Sub TextBox1_Change()   検索.Enabled = True   次へ.Enabled = False End Sub '▽Unloadさせず、値とボタン状態をリセット Private Sub 初期化_Click() With Me   .次へ.Enabled = False   .Label1.Caption = "検索値を入れて検索ボタンを押してください。"   .TextBox1.Value = "" End With End Sub '▽On Errorを使わず検索結果を判定、メモシートも検索して変数に代入 Private Sub 検索_Click() Dim 検索値 As String  '変数を宣言。 Dim 検索セル As Range  '検索結果のセルを代入するセル変数 検索値 = TextBox1.Value If 検索値 = "" Then   MsgBox "検索する語句を入れてください。"   TextBox1.SetFocus  'TextBox1にカーソルを移動。 Else   '▼「職員データ」シートをアクティブにして検索   Worksheets("職員データ").Activate   Set 検索セル = Cells.Find(What:=検索値, After:=Selection, LookIn:=xlValues, LookAt:= _       xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _       False, MatchByte:=False)   '検索で見つかれば選択、見つからなければerrhandlerへ移動   If 検索セル Is Nothing Then GoSub errhandler Else 検索セル.Select      '▼「メモ」シートをアクティブにして検索   Worksheets("メモ").Activate   Set 検索セル = Cells.Find(What:=検索値, After:=Selection, LookIn:=xlValues, LookAt:= _       xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _       False, MatchByte:=False)   '検索で見つかれば選択、見つからなければerrhandlerへ移動   If 検索セル Is Nothing Then     メモRow = 0 '見つからなかったらメモRowを0にする     GoSub errhandler   Else     検索セル.Select     メモRow = 検索セル.Row '変数に行番号を代入   End If      検索.Enabled = False   次へ.Enabled = True   Label1.Caption = "次をさがすには「次へ」ボタンを押してください。"  'Label1のメッセージを変える。 End If Exit Sub 'プロシージャを終了 '▼見つからない場合の処理 errhandler:   MsgBox """" & ActiveSheet.Name & """シートにその検索値は存在しません。"   '最終行を選択   Cells(Rows.Count, "A").End(xlUp).Select   Return '呼び出し元へ戻る End Sub '▽『検索_Click』とほぼ同じなのでコメント省略 Private Sub 次へ_Click() Dim 検索セル As Range Worksheets("職員データ").Activate Set 検索セル = Cells.FindNext(After:=Selection) If 検索セル Is Nothing Then GoSub errhandler Else 検索セル.Select Worksheets("メモ").Activate Set 検索セル = Cells.FindNext(After:=Selection) If 検索セル Is Nothing Then   GoSub errhandler   メモRow = 0 Else   検索セル.Select   メモRow = 検索セル.Row End If Exit Sub errhandler:   MsgBox """" & ActiveSheet.Name & """シートにその検索値は存在しません。"   Cells(Rows.Count, "A").End(xlUp).Select   Return End Sub '▽DATAフォームのLoadが無かったので追加 Private Sub 閉じる_Click() Unload Me Load DATA DATA.Show End Sub ■(3)ユーザーフォーム「DATA」へ記述 '▽DATAフォームは適当に作成しました。 ' (機能としては以下の仕様) '【1】メモRowの値をLabel1に表示させる '【2】「メモ」シートの検索行に文字を入力する '【1】ラベルにメモRow(広域変数)を表示する Private Sub メモRowを表示_Click() Me.Label1.Caption = メモRow End Sub '【2】「メモ」シートの検索行に文字を出力する Private Sub 入力して終了_Click() If メモRow = 0 Then Exit Sub 'メモRowが0なら終了 '「メモ」シートの検索行のB列にテキストボックスの内容を入力 Worksheets("メモ").Cells(メモRow, "B").Value = Me.TextBox1.Value Unload Me End Sub

16bis
質問者

補足

早速、詳しいご教示ありがとうございます。 このユーザーフォームを作るのにインターネットで色々調べつぎはぎして数ヶ月がかりで作成しましたが、質問をしてすぐに返事を頂き、ただただ驚嘆しております!! 検索して表示するところまで作成しました。上手くいかないところがあります。 (1)職員データ・メモ 両方のシートに職員番号がある場合。  検索画面を閉じるとメモシート上にデータフォームが表示され肝心の職員のデータが表 示されない '▽DATAフォームのLoadが無かったので追加 Private Sub 閉じる_Click() Unload Me Worksheets("職員データ").Activate ←この行を追加すると職員データシートに表示 Load DATA               されるようになりました。 DATA.Show End Sub (2)職員データにあってメモシートにない場合  検索フォームの閉じるをクリックすると    実行時エラー'1004': アプリケーション定義またはオブジェクト定義エラーです 。  とメッセージが有りデバッグ を押すと 検索画面のコードが表示され '▽DATAフォームのLoadが無かったので追加 Private Sub 閉じる_Click() Unload Me Worksheets("職員データ").Activate Load DATA ←この行が黄色く反転しています。 DATA.Show End Sub と表示されます ※検索フォームを閉じる前は メモシート上で "メモ"フォームにその検索値は存在しません。のお知らせが有り OKを押すと 検索画面は表示されていて カーソルは最終の職員番号の位置に有り この検索画面の閉じるボタンを押すと上記のようになります。 ※私としてはこのとき iカーソルはメモシートの最終の職員番号の下(新しく職員番号・氏名・メモを書きたいため) ii閉じるボタンを押すと職員データシートに移りメモ以外の職員のデータは表示したい ここはまだ教えていただいた所を試していませんが iii当月のメモ内容をメモシートに書き込みたい。職員コード・氏名(これは職員データにあります)・メモを最終行に書き込みたい 職員データは毎月総務課で作成し、私は給与計算の時このデータを参考にしております。当月間違いがあって次月にメモとして残したい時や、総務課で作成するデータ以外の事もデータとして残しておきたいのでこのようにメモシートを独立して作りました。メモシートはA:職員コード B:氏名 C:メモ です。ちょうど今、やっと9月の給与計算が終了し今度は月末の処理が始まります。このエクセルのシートが上手く動くようになれば自分の仕事がこの上なくスムースに進むと思います。どうぞよろしくご教示くださいますようお願いいたします。

関連するQ&A