A列 B列 C列 D列・・・M列
ID 名前 区分 日付・・・備考欄
というようなデータで1000行以上になる予定で作っています。
ユーザーフォーム上でIDを入力・検索した結果を同じフォーム内に表示させたいと思っています。
その際、
(1)同じIDが何度も登録されている時もあるのですが、重複OKですべてを表示させたい(スクロールバーなど使用したい)
(2)列はA~MまであるのですがA・B・Dの3列のみをフォーム内に表示させたい
(もし可能なら、(3)同じ形式の複数シートからの検索結果をまとめて表示させる方法も教えて欲しいのですが)
Excelに詳しい方、よろしくお願いします。
No.1ベストアンサー
- 回答日時:
こんばんは。
>重複OKですべてを表示させたい
それは、配列変数に溜めていくぐらいしか思いつかないですね。
ユーザーフォームには、
検索入力用の、TextBox1 と CommandButton1 と ListBox1 を、それぞれひとつずつ用意します。
出力は、ListBox にします。フォントサイズは、適当に換えてください。標準では、かなり小さいです。
ListBox のプロパティの ColumnCount は、2を入れてください。
後は、それなりに手を加えて、良いようにしてください。
'ユーザーフォームモジュール
'Option Explicit
Private i As Long
Private Sub CommandButton1_Click()
Dim SearchText As String
Dim PickUp()
Dim sh As Worksheet
SearchText = Me.TextBox1.Text
If Me.TextBox1.Text = "" Then Exit Sub
ReDim PickUp(1, 0)
SearchFind ActiveSheet, SearchText, PickUp
If MsgBox("他のシートも調べますか?", vbOKCancel) = vbOK Then
For Each sh In ThisWorkbook.Worksheets
If Not sh Is ActiveSheet Then
SearchFind sh, SearchText, PickUp
End If
Next sh
End If
Me.ListBox1.List = WorksheetFunction.Transpose(PickUp())
End Sub
Sub SearchFind(sh As Worksheet, _
SearchText As String, _
PickUp())
Dim myAdd As String
Dim c As Range
Set c = sh.UsedRange.Columns(1).Find( _
What:=SearchText, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchByte:=True)
If Not c Is Nothing Then
myAdd = c.Address
ReDim Preserve PickUp(1, i)
PickUp(0, i) = c.Offset(, 1).Value 'B列
PickUp(1, i) = c.Offset(, 3).Value 'D列
i = i + 1
Do
Set c = sh.UsedRange.Columns(1).FindNext(c)
ReDim Preserve PickUp(1, i)
PickUp(0, i) = c.Offset(, 1).Value
PickUp(1, i) = c.Offset(, 3).Value
i = i + 1
Loop Until c Is Nothing Or c.Address = myAdd
End If
End Sub
素早い回答ありがとうございます、おかげ様でかなり希望に近いものができそうです。
いろいろいじってみたのですが、わからない点があり教えていただけないでしょうか?
(4)抽出したデータが重複表示されてしまいます、2番目に抽出したデータがリストの最初と最後に出てくるのですが原因をつきとめられませんでした。
(5)抽出したリストを日付(D列)が新しい順に表示させたい。
お手数かけて申し訳ないのですが、よろしくお願いします。
No.2
- 回答日時:
こんばんは。
Wendy02です。(4)は、訂正しました。 (5) は、ソートプログラムをサブルーチンで追加してみました。
日付 は、一旦、シリアル値に戻されます。最初に見つかった書式に対して、出力は、すべてを統一して書式を変更します。
こちらで試した限りは、問題は解消されているように思いますが、試してみてください。
'ユーザーフォームモジュール
'Option Explicit
Private i As Long
Private rFormat As String
Private Sub CommandButton1_Click()
Dim SearchText As String
Dim PickUp()
Dim sh As Worksheet
SearchText = Me.TextBox1.Text
If Me.TextBox1.Text = "" Then Exit Sub
i = 0 'カウントの初期化
rFormat = "" 'セルの書式の初期化
ReDim PickUp(1, 0)
SearchFind ActiveSheet, SearchText, PickUp
If MsgBox("他のシートも調べますか?", vbOKCancel) = vbOK Then
For Each sh In ThisWorkbook.Worksheets
If Not sh Is ActiveSheet Then
SearchFind sh, SearchText, PickUp
End If
Next sh
End If
BSort PickUp, rFormat '並べ替えサブルーチン
Me.ListBox1.List = WorksheetFunction.Transpose(PickUp())
End Sub
Sub SearchFind(sh As Worksheet, _
SearchText As String, _
PickUp())
Dim myAdd As String
Dim c As Range
Set c = sh.UsedRange.Columns(1).Find( _
What:=SearchText, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, _
MatchByte:=True)
If Not c Is Nothing Then
myAdd = c.Address
ReDim Preserve PickUp(1, i)
PickUp(0, i) = c.Offset(, 1).Value 'B列
PickUp(1, i) = c.Offset(, 3).Value2 'D列 シリアル値の格納
If rFormat = "" Then rFormat = c.Offset(, 3).NumberFormatLocal
i = i + 1
Do
Set c = sh.UsedRange.Columns(1).FindNext(c)
If c.Address = myAdd Then Exit Sub
ReDim Preserve PickUp(1, i)
PickUp(0, i) = c.Offset(, 1).Value 'B列
PickUp(1, i) = c.Offset(, 3).Value2 'D列 シリアル値の格納
i = i + 1
Loop Until c Is Nothing
End If
End Sub
Private Sub BSort(ar() As Variant, Optional dtFormat As String)
'バブルソート/ar() 二次元配列, dtFormat 日付書式
Dim u As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim t1 As Variant
Dim t2 As Variant
u = UBound(ar(), 2)
i = LBound(ar(), 2)
Do While i < u
j = u
Do While j > i
If ar(1, j) < ar(1, i) Then '昇順
t1 = ar(0, j)
t2 = ar(1, j)
ar(0, j) = ar(0, i)
ar(1, j) = ar(1, i)
ar(0, i) = t1
ar(1, i) = t2
End If
j = j - 1
Loop
i = i + 1
Loop
'Option
For k = LBound(ar(), 2) To UBound(ar(), 2) '書式戻し
ar(1, k) = Format$(ar(1, k), dtFormat)
Next k
End Sub
ありがとうございます、おかげ様で無事に解決しました。
今まで配列にほとんど触れなかったのでいい勉強になりました。
今回訂正していただいたコードで、検索結果が一つしかなかった場合にTransposeがうまくはたらかず(?)結果(B・D列)が縦に表示されてしまいました。
そこで1日悩んで
ReDim Preserve PickUp(1, i)
の一文を Me.ListBox1.List ・・・の前に入れてみました、今のところ順調のようです。
どうもありがとうございました!!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Access(アクセス) AccessVBAで降順にするテーブル作成クエリを使用して作成したテーブルを削除し同一のテーブル作成 1 2023/01/06 11:17
- Excel(エクセル) VLOOKUP が機能しない、その原因は何 ? 8 2022/10/19 12:06
- Visual Basic(VBA) 検索のユーザーフォームの表示について 1 2023/03/27 23:31
- Excel(エクセル) ExcelのVLOOKUP関数 7 2022/08/23 06:46
- Access(アクセス) Access2016でフォーム内にExcelの複数シートを 表示させるイメージで複数テーブルの デー 1 2022/11/25 15:30
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- Visual Basic(VBA) Excel VBAのリストボックスの値を他のフォームに反映させる方法を教えてください。 2 2023/07/14 14:06
- Access(アクセス) Dlookupにエラーがでてしまう 1 2022/10/31 14:35
- JavaScript フォームが空欄の時にフォームの外をクリックすると、エラーが出るコードを調べています。 1 2023/06/25 11:51
- Visual Basic(VBA) ユーザーフォーム「frm_基本❶」を立ち上げると新規で入力する行数を右下のNoとして表示しています。 1 2023/03/16 19:02
このQ&Aを見た人はこんなQ&Aも見ています
-
賃貸で可能な古民家風レトロな部屋作りのコツ!改めて知る畳の高い機能性と魅力も紹介
畳の部屋を雰囲気のよい部屋に仕上げたい!賃貸住宅でもできる古民家風のレトロな部屋作りのコツを伺った。
-
ユーザーフォームに別シートからデータを反映させたい。
Visual Basic(VBA)
-
エクセルのラベルの値(文字列)を垂直方向で中央揃えにするには?
Excel(エクセル)
-
Excel VBA 検索した値を入力フォームに表示
Visual Basic(VBA)
-
-
4
ユーザーフォームで別シートを検索できますか
Excel(エクセル)
-
5
エクセルVBAリストボックスに表示された検索結果をクリックして、該当するセルをアクティブセルにしたい
Excel(エクセル)
-
6
ユーザーフォームのテキストボックスに前回入力した値を表示する Excel
Visual Basic(VBA)
-
7
Excel VBAのリストボックスの値を他のフォームに反映させる方法を教えてください。
Visual Basic(VBA)
-
8
Excelで検索結果をテキストボックスに表示
Windows Vista・XP
-
9
EXCELのフォーム上でリアルタイムな曖昧検索を行いたい
Visual Basic(VBA)
-
10
ExcelのComboboxでマウスのスクロールを有効にしたい
Excel(エクセル)
-
11
UserForm1.Showでエラーになります。
工学
-
12
VBA。リストボックスの値を別のユーザーフォームのテキストボックスに反映したい。
Access(アクセス)
-
13
検索のユーザーフォームの表示について
Visual Basic(VBA)
-
14
Excel VBA ユーザーフォーム1のコンボボックスに別ブックの値を反映させたいです。
Visual Basic(VBA)
-
15
ユーザーフォームを表示中にシートの操作をさせるには
Excel(エクセル)
-
16
エクセルVBA ユーザーフォームのTextBoxを日付にしたい
Excel(エクセル)
-
17
テキストボックスの番号を使ったFor~Next文について
Visual Basic(VBA)
-
18
ユーザーフォームへのデータ入力を繰り返す方法
Visual Basic(VBA)
-
19
エクセルVBA テキストボックスに3桁ごとにコンマ
Visual Basic(VBA)
-
20
excelのリストボックスで選択した項目をアクティブセルに入力方法
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルの関数について教えて...
-
Excelカスタム関数(アドイン登...
-
Excelデータをコピペして、ペー...
-
Excel関数-文字列で自動作成さ...
-
スプレッドシート、Excelでの数...
-
Excelで50個のセルに同じ文字を...
-
Microsoft Officeの中古は信用...
-
スプレッドシートで使う数式を...
-
エクセルVBA、別ブックへ転記す...
-
エクセルで会社の従業員のデー...
-
エクセルで不等号記号(≠)が上に...
-
エクセルの表で1年間の曜日を...
-
A列とB列を参照してC列に連番を...
-
エクセルの空欄をつめて、次の...
-
エクセルでの特別な文字を上に...
-
エクセルでセルに標準で入力さ...
-
エクセル日付 文字列の関数がエ...
-
エクセル2013で月間勤務表から...
-
エクセルの日付を編集する
-
EXCELの質問です 119から足した...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBA、別ブックへ転記す...
-
エクセルでの作業計算方法について
-
時間によってファイル名が変わ...
-
【関数】適切な文字数の数字を...
-
Excelについて教えてください
-
エクセル初心者です 関数の入れ...
-
【マクロ】ファイル名の変更に...
-
UNIQUE関数が使えないバージョ...
-
エクセルの計算
-
【関数】先頭だけにある、半角...
-
Excelで、決まった行を繰り返し...
-
Excelでセルの値が同じか...
-
LOOKUP関数を使えばいいのでし...
-
Excel
-
はがきについて。
-
エクセルの条件付き書式につい...
-
エクセルのデーターが2か月前の...
-
エクセル②
-
エクセルで「-0.0」と表示さ...
-
Microsoft1Officeの互換ソフト...
おすすめ情報