[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『リストボックスに複数列表示できるように変更したい』（初心者h）
前任者より、引き継いだマクロを修正しています。
初心者のためその都度出てくる記載を勉強しながら進めていますが、
うまくいかないためご指導いただければ幸いです。
一覧sheet
A列：NO
B列：登録日
C列：作成者
D列:内容
検索用のフォームにキーワードを入力し
Ｄ列の中から部分一致するセルがある行を検索してリストボックスに表示し
検索結果から、選択したデーターを検索用sheetに表示させています。
現在、リストボックスは1列(お知らせ内容のみ）ですが、
3列にして作成日、作成者も表示させたいと考えています。
'一覧を検索
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'部分一致でお知らせ内容を検索
の前に
ReDim any_d(2 To i, 2 To 4)
を追加して、
ListBox1.AddItem Sheets("一覧").Cells(i, "D") 'リストボックスに値を追加
を削除して、END if nexr以下に
'リストボックスの表示形式を設定
With ListBox1
.ColumnCount = 3
.ColumnWidths = "30;30;60"
.List = any_d
End With
と記載しましたが、 ReDim any_d(2 To i, 2 To 4)
のところでメモリが不足しています というエラーがかかります。
any_dはDim any_d As Variantとしています。
現在、リストボックスは1列表記での動作確認はできており、
以下のようなコードがフォームに登録されています。
どなたかご指導いただけませんでしょうか？
よろしくお願いいたします。
Private Sub CommandButton1_Click()
Unload frmキーワード検索
End Sub
Dim i As Integer
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
ListBox1.Clear 'リストボックスをクリア
'一覧を検索
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'部分一致でお知らせ内容を検索
If InStr(Sheets("一覧").Cells(i, "D"), TextBox1.Text) > 0 Then
ListBox1.AddItem Sheets("一覧").Cells(i, "D") 'リストボックスに値を追加
End If
Next
'リストボックスにデータがある場合
If ListBox1.ListCount > 0 Then
ListBox1.SetFocus 'リストボックスをフォーカス
ListBox1.ListIndex = 0 '一番上を選択
Else
KeyCode = 0 'テキストボックスをフォーカスしたままにする
MsgBox "データがありません"
End If
End Sub
Dim i As Integer
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
'一覧を検索する
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'リストボックスで選択したキーワードを含むお知らせを検索フォームに表示
If Sheets("一覧").Cells(i, "D") = ListBox1.List(ListBox1.ListIndex) Then
Sheets("検索フォーム").Range("C1") = Sheets("一覧").Cells(i, "A") 'NO
Sheets("検索フォーム").Range("C2") = Sheets("一覧").Cells(i, "B") '作成日
Sheets("検索フォーム").Range("C3") = Sheets("一覧").Cells(i, "C") '作成者
Sheets("検索フォーム").Range("B6") = Sheets("一覧").Cells(i, "D") 'お知らせ内容
End If
Next
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
返信いただきありがとうございます。
教えていただいた
ListBox1.list = range("A1:C5").value
をどの部分についかすればよろしいのでしょうか？
また、私が新たに追加しょうとした部分はすべてさくじょしたほうがよろしいのでしょうか？
教えていただけると嬉しいです。よろしくお願いします。
（初心者h） 2023/05/07(日) 10:01:09
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer Dim any_d As Variant 'リストに設定するデータ用配列 Dim last_row As Long
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
ListBox1.Clear 'リストボックスをクリア
last_row = Sheets("一覧").Cells(Rows.Count, 1).End(xlUp).Row
any_d = Sheets("一覧").Range("A2:D" & last_row)
'一覧を検索
For i = 2 To Sheets("一覧").Cells(Rows.Count, "C").End(xlUp).Row
'部分一致で商品を検索
If InStr(Sheets("一覧").Cells(i, "C"), TextBox1.Text) > 0 Then
ListBox1.AddItem Sheets("一覧").Cells(i, "C") 'リストボックスに値を追加
End If
'リストボックスの表示形式を設定
With ListBox1
.ColumnCount = 3
.ColumnWidths = "30;30;60"
.List = any_d
End With
Next
'リストボックスにデータがある場合
If ListBox1.ListCount > 0 Then
ListBox1.SetFocus 'リストボックスをフォーカス
ListBox1.ListIndex = 0 '一番上を選択
Else
KeyCode = 0 'テキストボックスをフォーカスしたままにする
MsgBox "データがありません"
End If
End Sub
（初心者h） 2023/05/07(日) 12:07:46
（わからん） 2023/05/07(日) 14:47:46
ちょっと分かりにくいけど、こんな事かな？
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
ListBox1.Clear 'リストボックスをクリア
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "60;30;60"
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'部分一致で商品を検索
If InStr(Sheets("一覧").Cells(i, "D"), TextBox1.Text) > 0 Then
With ListBox1
.AddItem ""
.List(.ListCount - 1, 0) = Sheets("一覧").Cells(i, "B").Text
.List(.ListCount - 1, 1) = Sheets("一覧").Cells(i, "C").Value
.List(.ListCount - 1, 2) = Sheets("一覧").Cells(i, "D").Value
End With
End If
Next
'リストボックスにデータがある場合
If ListBox1.ListCount > 0 Then
ListBox1.SetFocus 'リストボックスをフォーカス
ListBox1.ListIndex = 0 '一番上を選択
Else
KeyCode = 0 'テキストボックスをフォーカスしたままにする
MsgBox "データがありません"
End If
End Sub
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Integer
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
'一覧を検索する
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'リストボックスで選択したキーワードを含むお知らせを検索フォームに表示
If Sheets("一覧").Cells(i, "D") = ListBox1.List(ListBox1.ListIndex, 2) Then
Sheets("検索フォーム").Range("C1") = Sheets("一覧").Cells(i, "A") 'NO
Sheets("検索フォーム").Range("C2") = Sheets("一覧").Cells(i, "B") '作成日
Sheets("検索フォーム").Range("C3") = Sheets("一覧").Cells(i, "C") '作成者
Sheets("検索フォーム").Range("B6") = Sheets("一覧").Cells(i, "D") 'お知らせ内容
Exit For
End If
Next
End Sub
（半平太） 2023/05/07(日) 20:25:08
＞ListBox1.AddItem Sheets("一覧").Cells(i, "D") 'リストボックスに値を追加
まったく同じ内容がD列に２つ以上あったら この処理はマズいことになると思うのですが、 そこ大丈夫なんですか？
（半平太） 2023/05/07(日) 22:28:21
＞Ｄ列の中から部分一致するセルがある行を検索してリストボックスに表示し
リストボックスに表示する訳は何ですか。
リストボックスに表示した後はどうするんですか。
リストボックスから選択するのが通常ですけど。
リストボックスに抽出されたものの中から選択して
検索フォームSheetに表示させています。
（初心者h） 2023/05/08(月) 22:25:34
前回の質問に引き続きご教授いただき誠にありがとうございます。
＞ListBox1.AddItem Sheets("一覧").Cells(i, "D") 'リストボックスに値を追加
まったく同じ内容がD列に２つ以上あったら この処理はマズいことになると思うのですが、 そこ大丈夫なんですか？
D列は文章の記載なのですが、各行に同じキーワードが何度か出てくる可能性はあります。
例えば 一覧表Sheetが以下のような場合
A列 B列 c列 D列
１ 2023/5/3 山本 検索したい
２ 2023/5/3 佐藤 検索できるかな
３ 2023/5/4 田中 上書きするよ
４ 2023/5/5 山本 新規登録
５ 2023/5/6 佐藤 検索して上書き保存
D列を部分一致で キーワード「検索」で検索したときに
リストボックスには
NO１．２．５が表示されるのをイメージしています。
リストボックス1列の時はこれでうまくいってたのですが、このやり方で継続していくと今後問題がしょうじてくるのでしょうか？
（初心者h） 2023/05/08(月) 22:38:02
＞リストボックス1列の時はこれでうまくいってたのですが、 ＞このやり方で継続していくと今後問題がしょうじてくるのでしょうか？
いや、以前からリスキーだったと思いますよ。下例の場合・・
１ 2023/5/3 山本 検索したい ←メモが全く同じ ２ 2023/5/3 佐藤 検索したい ←メモが全く同じ ３ 2023/5/4 田中 上書きするよ ４ 2023/5/5 山本 新規登録 ５ 2023/5/6 佐藤 検索したい ←メモが全く同じ
リストアップは問題ないですが、 リストボックスから一つ選んでEnterキー押下しても １、２，５の内、どれを検索シートに呼び出すかは、曖昧です。
何故なら、D列が一致しているかどうかしか判定していません。 (何日なのか、担当者は誰なのかチェックしていません)
以前は、一番下にある日付のものを呼び出します。（常にそれでよければ問題はなかったです） 私の修正コードは、一番上にある日付のものを呼び出します。（常にそれでよければ問題はないです）
そんな仕掛けで実務が進められますか？（メモが全く同じであることは皆無と言えるなら問題はないですが）
（半平太） 2023/05/08(月) 23:18:30
>リストアップは問題ないですが、 リストボックスから一つ選んでEnterキー押下しても １、２，５の内、どれを検索シートに呼び出すかは、曖昧です。
実際のデーターでは、D列の記載内容がかなり長文になっています。
そのため、リストボックスで確認できる文字数の範囲では判定するのが難しく、
フォームに表示させることで内容を確認し
もし見たかった内容と違ってれば、
リストアップされた中から別のものを表示させて確認という流れになっていました。
現在、特にそのやり方でもんだいはなかったのですが、
フォームに表示させたいものを推察するためのプラス情報として、
リストボックスの列を追加して
作成日、作成者の情報も表示させたいと考えていました。
本当をいうと、One Noteでのデータ管理に移行したいのですが
新しいアプリの活用に抵抗を感じる人もいるため
現行のやり方の改良版を同時に代替案として出そうと考えていました。
（初心者h） 2023/05/08(月) 23:52:14
事情は分かりました。
ListBox1_KeyDownのプロシージャを以下に差し替えてください。
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Long, k As Long, sToCk As String
If KeyCode <> vbKeyReturn Then Exit Sub 'Enter以外は、処理を終了
'一覧を検索する
sToCk = ListBox1.List(ListBox1.ListIndex, 2)
k = -1
For i = 2 To Sheets("一覧").Cells(Rows.Count, "D").End(xlUp).Row
'リストボックスで選択したキーワードを含むお知らせを検索フォームに表示
If Sheets("一覧").Cells(i, "D") = sToCk Then
k = k + 1
If k = ListBox1.ListIndex Then
Sheets("検索フォーム").Range("C1") = Sheets("一覧").Cells(i, "A") 'NO
Sheets("検索フォーム").Range("C2") = Sheets("一覧").Cells(i, "B") '作成日
Sheets("検索フォーム").Range("C3") = Sheets("一覧").Cells(i, "C") '作成者
Sheets("検索フォーム").Range("B6") = Sheets("一覧").Cells(i, "D") 'お知らせ内容
Exit For
End If
End If
Next
End Sub
（半平太） 2023/05/09(火) 09:10:59 一部改修 09:50:00
お返事いただきありがとうございます。
おしえていただいたコードで試してみたところ、
抽出されたリストの一番上の行はフォームに表示させることができるのですが、
2行目以降は選択することができませんでした。
どこを修正すればよいのか、私の能力の範囲を超えてしまっていて
見当もつきません。
大変申し訳ないですが、お時間あるときで構いませんので
修正方法をおしえていただけませんでしょうか？
（みね） 2023/05/10(水) 13:30:27
もっと簡単な方法が沢山あるのでしょうが、
Excel自体の知識も限定されているせいで思い浮かばない方法も多くて、、、
ユーザーフォームを使わずワークシートに直接検索結果を表示させたり、
フィルタの詳細設定を用いたりすればもっと単純にできたのかな？
とか進めるにつれてわかってきた感じです。
同じことをやるにももっと単純にできる方法がいろいろあるようですので
これを機会に勉強していきたいとおもいます。
（みね） 2023/05/10(水) 13:34:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.