Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1 / 13620 ﾂﾘｰ

前へ→

▼

【82283】検索できるドロップダウン 名無し 24/5/9(木) 7:37

【82285】Re:検索できるドロップダウン マナ 24/5/9(木) 22:15

【82286】Re:検索できるドロップダウン 名無し 24/5/10(金) 12:13


	【82283】検索できるドロップダウン

名無し - 24/5/9(木) 7:37 -


	引用なし

	パスワード

VBA初心者です。

★youtube.com/watch?v=urNR55Ly5gE&si=BsLig7iB2QudvSqk (★→ｈｔｔｐｓ：／／)
こちらの動画を参考に、検索できるドロップダウンリストを1つのセルに作成しました。
(例:セルに「佐藤」と入力すると佐藤太郎と佐藤花子がリストに表示される)
このドロップダウンリストを列全てに設定したいのですが、どのようにしたら良いかわからず、ご教示いただけますと幸いです。

前提
・会社のPCに入ってるExcelが2019のため、FILTER関数などは使用できません
・入力シートのC列にドロップダウンで従業員氏名を入力したいです(下記ではC3セルに適用してますが、C列全てに検索できるドロップダウンを適用したいです)
・従業員名簿シートC列に従業員氏名(フルネーム・漢字)が羅列されています
・従業員氏名は今後追加・削除などを行う予定がありますが、参照を列にしているため問題ないと思われます
・従業員名簿シートJ列(空白列)に検索結果を表示させています
・参考動画ではかな、カナでも検索できるようにしてますが、漢字のみで検索できれば十分です
・また、or・and検索も不要です

・入力シートC3セルにデータの入力規則を設定(リスト)
　=OFFSET(従業員名簿!$J$2,0,0,4)
　※同姓者が2・3名なので仮で4行表示としてます

＿＿＿以下、コード＿＿＿＿＿

Private Sub Worksheet_Change(ByVal Target As Range)

　　'C3セルではないので終了
　　If Target.Address <> "$C$3"
　　　　Exit Sub
　　End If

　　'候補を作成
　　Call 候補を作成

　　'入力された値が候補と一致する場合は、選択されたので終了
　　If Worksheets(“入力シート”).Range("C3").Value = Worksheets(“従業員名簿”). Range("J2").Value And _
　　　 Worksheets(“入力シート”).Range("C3").Value <> "" And _
　　　 Worksheets(“従業員名簿”).Range("J3").Value = "" Then
　　　　Exit Sub
　　End If

　　'プルダウン表示
　　Worksheets(“入力シート”). Range("C3").Select
　　If Worksheets(“入力シート”). Range("C3").Value <> "" Then
　　　　SendKeys "%{DOWN}"
　　End If

End Sub

Public Sub 候補を作成()

　　Dim 元の行 As Long
　　Dim 先の行 As Long
　　Dim 検索文字 As String
　　
　　
　　'現在のプルダウン候補の列をクリア
　　Worksheets(“従業員名簿”).Range("J:J").ClearContents
　　
　　元の行 = 2
　　先の行 = 2
　　検索文字 = Worksheets(“入力シート”). Range("C3").Value
　　
　　'大元のデータ終了までループ
　　Do Until Worksheets(“従業員名簿”). Cells(元の行, 3).Value = ""
　　　　
　　　　If InStr(Worksheets(“従業員名簿”).Cells(元の行,3).Value,検索文字)>0 Or_
　　　　検索文字 = “” Then
　　　　　　'該当あり
　　　　　　Worksheets(“従業員名簿”). Cells(先の行, 10).Value = Worksheets(“従業員名簿”). Cells(元の行, 3).Value
　　　　　　先の行 = 先の行 + 1
　　　　End If
　　　　
　　　　元の行 = 元の行 + 1
　　
　　Loop

End Sub


	【82285】Re:検索できるドロップダウン

マナ - 24/5/9(木) 22:15 -


	引用なし

	パスワード

▼名無しさん：

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim r As Range, c As Range
　　Dim w, v
　　
　　Set r = Intersect(Target, Columns(3))
　　If r Is Nothing Then Exit Sub
　
　　With Worksheets("従業員名簿")
　　　　w = Application.Transpose(.Range("C2", .Cells(Rows.Count, 3).End(xlUp)))
　　End With
　　
　　r.Validation.Delete
　
　　For Each c In r
　　　　If c.Row > 2 Then
　　　　　　If c.Value <> "" Then
　　　　　　　　v = Filter(w, c.Value)
　　　　　　　　Application.EnableEvents = False
　　　　　　　　If UBound(v) = -1 Then
　　　　　　　　　　c.ClearContents
　　　　　　　　ElseIf UBound(v) = 0 Then
　　　　　　　　　　c.Value = v
　　　　　　　　Else
　　　　　　　　　　c.Validation.Add Type:=xlValidateList, Formula1:=Join(v, ",")
　　　　　　　　End If
　　　　　　　　Application.EnableEvents = True
　　　　　　End If
　　　　End If
　　Next

End Sub


	【82286】Re:検索できるドロップダウン

名無し - 24/5/10(金) 12:13 -


	引用なし

	パスワード

▼マナ様：
レスありがとうございます。
無事動かすことができました。
大変助かりました。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1 / 13620 ﾂﾘｰ

前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free