[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『2-UserForm、ListBoxに指定の値の該当値を別のListBoxに表示 2』（ひなの ）
[[20160629222233]]『1-UserForm、ListBoxに指定の値の該当値を別のListBoxに表示』（ひなの ）
Q1.ユーザーフォームであいまい検索 TextBox1に「ひ」と入力後、ListBox1に「ひ」が入っているすべてのの会社名を表示する ・検索値（英数大文字小文字、ひらがな、漢字、カタカナ）
Q2.ListBox1の値をクリック後ListBox2に売上の値を表示 ・売上表示条件（同じ商品NO・同じ金額の場合＝一行にする 同じ商品NO・違う金額の場合＝そのまま表示する）
Q3.ListBox1の値をクリック後ListBox3に顧客シート13列目の値を表示
▼フォーム 顧客 CommandButton1 '入力 エクセルへ CommandButton2 ’終了 TextBox1 'あいまい検索 ⇒ 顧客情報を引っ張ってくる ListBox2 ’購入履歴 ⇒ 売上から購入商品を引っ張ってくる ListBox3 ’注意 ⇒ 顧客から注意ランのデータを引っ張ってくる（データーは空欄のもある）
◆相談結果（ひなのメモ）
Dim posCt1 As Range
Dim posList1 As Range Dim posCt2 As Range Dim posList2 As Range Dim posList4 As Range Const COLS売上 As Long = 11 Const COLS顧客 As Long = 14 Dim orgBack As Long
Private Sub UserForm_Initialize()
'リストボックス1
With ListBox1
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = COLS顧客
.ColumnWidths = "30;90;0;0;150;80;200;0;0;0;0;0;0;0"
.BoundColumn = 5
orgBack = .BackColor
End With
'リストボックス2
With ListBox2
'作業シートの列NOを数える、売上の列番号と異なる
.ColumnCount = COLS売上
.ColumnWidths = "0;0;0;0;0;0;50;150;0;50;30"
End With
With Sheets("作業")
Set posCt1 = .Range("A1") 'ListBox1用抽出条件領域
Set posList1 = posCt1.Offset(, 2) 'ListBox1用リスト領域
Set posCt2 = posList1.Offset(, COLS顧客 + 1) 'ListBox2用抽出条件領域
Set posList2 = posCt2.Offset(, 2) 'ListBox2用リスト領域
End With
TextBox1_Change
End Sub
Private Sub TextBox1_Change()
Dim r As Range
Dim s1 As String
Dim s2 As String
With ListBox1
.RowSource = ""
.ColumnHeads = False
.BackColor = orgBack
End With
ResetList
With Sheets("顧客") '範囲
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 14)
End With
s1 = StrConv(TextBox1.Value, vbUpperCase) '文字列を大文字に変換
s2 = StrConv(TextBox1.Value, vbLowerCase) '文字列を小文字に変換
'フィルターオプションの条件、縦に並べると OR 条件 ANDはできない
With Sheets("作業") 'フィルター結果を作業シートにコピーする
.UsedRange.ClearContents
posCt1.Value = Sheets("顧客").Range("E1").Value '条件タイトル
'大文字小文字等で検索したい場合は設定
posCt1.Cells(2).Value = "*" & StrConv(s1, vbWide) & "*" '半角文字を全角文字に変換
posCt1.Cells(3).Value = "*" & StrConv(s1, vbNarrow) & "*" '全角文字を半角文字に変換
posCt1.Cells(4).Value = "*" & StrConv(s2, vbWide) & "*"
posCt1.Cells(5).Value = "*" & StrConv(s2, vbNarrow) & "*"
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=posCt1.CurrentRegion, CopyToRange:=posList1, Unique:=False
If Not IsEmpty(posList1.Cells(2, 1)) Then
With posList1.CurrentRegion
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox1.ColumnHeads = True
End With
Else
ListBox1.BackColor = vbRed
End If
End With
End Sub
Private Sub ListBox1_Click()
Dim r As Range
ResetList
With Sheets("売上")
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
End With
posList2.CurrentRegion.ClearContents
posCt2.Cells(1).Value = Sheets("売上").Range("D1").Value '抽出タイトル
posCt2.Cells(2).Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
posCt2.Cells(1, 2).Value = Sheets("売上").Range("E1").Value '抽出タイトル
posCt2.Cells(2, 2).Value = "<>0*" '抽出条件 0 ではじまらないもの
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=posCt2.CurrentRegion, CopyToRange:=posList2, Unique:=False
If Not IsEmpty(posList2.Cells(2, 1)) Then
posList2.CurrentRegion.Sort Order1:=xlAscending, Key1:=posList2.Columns(5), Order2:=xlDescending, Key2:=posList2.Columns(2), Header:=xlYes
posList2.CurrentRegion.RemoveDuplicates Columns:=Array(5, 8), Header:=xlYes
With posList2.CurrentRegion
ListBox2.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox2.ColumnHeads = True
ListBox3.List = Array(ListBox1.List(ListBox1.ListIndex, 12))
End With
Else
ListBox2.BackColor = vbRed
ListBox3.BackColor = vbRed
End If
End Sub
Private Sub ResetList()
With ListBox2
.RowSource = ""
.ColumnHeads = False
.BackColor = orgBack
End With
With ListBox3
.Clear
.BackColor = orgBack
End With
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
そちらのコードをなるべく踏まえながら書いてみました。 勝手に仕様をかえたところがあります。
・TextBox1 に入力して CommandButton1 をクリックしてあいまい検索をしていますが、 CommandButton1 を廃止、TextBox1に入力（確定）した時点で自動的に ListBox1 に抽出します。 ・ListBox1 の表示列は２列のみ。顧客名と注意のみにしました。
作業シートのハンドリングなので、処理をしている領域がコードからはわかりにくいかもしれませんが 実行後、作業シートを見ると、どこに、どんな作業域があるのかがわかると思います。
なお ListBox1 や ListBox2 の横幅や各列の幅は、適宜調整してください。
Private Sub UserForm_Initialize()
With ListBox1
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = 2
.ColumnWidths = "90;50"
End With
With ListBox2
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = 11
.ColumnWidths = "0;0;0;0;30;80;0;20;0;50;30"
End With
End Sub
Private Sub TextBox1_Change()
Dim r As Range
Dim s1 As String
Dim s2 As String
With ListBox1
.RowSource = ""
.ColumnHeads = False
End With
With Sheets("顧客") '範囲
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 14)
End With
s1 = StrConv(TextBox1.Value, vbUpperCase) '文字列を大文字に変換
s2 = StrConv(TextBox1.Value, vbLowerCase) '文字列を小文字に変換
'フィルターオプションの条件、縦に並べると OR 条件 ANDはできない
With Sheets("作業") 'フィルター結果を作業シートにコピーする
.UsedRange.ClearContents
.Range("A1").Value = Sheets("顧客").Range("E1").Value '条件タイトル
'大文字小文字等で検索したい場合は設定
.Range("A2").Value = "*" & StrConv(s1, vbWide) & "*" '半角文字を全角文字に変換
.Range("A3").Value = "*" & StrConv(s1, vbNarrow) & "*" '全角文字を半角文字に変換
.Range("A4").Value = "*" & StrConv(s2, vbWide) & "*"
.Range("A5").Value = "*" & StrConv(s2, vbNarrow) & "*"
.Range("C1").Value = .Range("A1").Value '抽出１列目タイトル
.Range("D1").Value = Sheets("顧客").Range("M1").Value '抽出２列目タイトル
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:A5"), CopyToRange:=.Range("C1:D1"), Unique:=False
If Not IsEmpty(.Range("C2")) Then
With .Range("C1").CurrentRegion
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox1.ColumnHeads = True
End With
End If
End With
End Sub
Private Sub ListBox1_Click()
Dim r As Range
With ListBox2
.RowSource = ""
.ColumnHeads = False
End With
ListBox3.Clear
With Sheets("売上")
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
End With
With Sheets("作業")
.Range("H1").CurrentRegion.ClearContents
.Range("F1").Value = Sheets("売上").Range("D1").Value '抽出タイトル
.Range("F2").Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("F1:F2"), CopyToRange:=.Range("H1"), Unique:=False
If Not IsEmpty(.Range("H2")) Then
.Range("H1").CurrentRegion.Sort Order1:=xlAscending, Key1:=.Columns("L"), Order2:=xlDescending, Key2:=.Columns("I"), Header:=xlYes
.Range("H1").CurrentRegion.RemoveDuplicates Columns:=Array(5, 8), Header:=xlYes
With .Range("H2").CurrentRegion
ListBox2.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox2.ColumnHeads = True
ListBox3.List = Array(ListBox1.List(ListBox1.ListIndex, 1))
End With
End If
End With
End Sub
（β） 2016/07/02(土) 00:44
追加です。
Private Sub TextBox1_Change() の中のどこでもいいのですが、
With ListBox2
.RowSource = ""
.ColumnHeads = False
End With
ListBox3.Clear
を加えてください。
（β） 2016/07/02(土) 00:53
大事なことと、気になること。
・フィルターオプションは 扱うリストのタイトルが命です。 このタイトル内に、同じ文字列があると、具合が悪くなるところがでてきます。 アップされたサンプル、 No というタイトルが２か所にありますが、一方を別タイトルにしてくださいね。
・ListBox1 の絞り込んだ結果の顧客リストですけど、アップされたコードに従って、顧客シートから抽出しています。 でも、考えてみると、その顧客コードから選択して抽出する相手は 売上 シート ですね。 とすると、売上シートに存在しないデータの顧客、たとえば （株）β などを表示したところで、 それを選んでもデータがありませんよね。ListBox2やListBox3が空っぽになるだけです。 であれば、ListBox1 は 顧客シートからではなく、売上シートの名前欄からあいまい抽出をしたほうが よくないですか？ （もっとも、βがアップしたコードで、ListBox1 に 【おまけ】で追加表示した【注意】は 売上シートにはないので、顧客名のみの１列になりますが）
（β） 2016/07/02(土) 08:38
まだ検証してませんが、ちょっと気になることが・・・・
≫・ListBox1 の表示列は２列のみ。顧客名と注意のみにしました。 ・ListBox3を廃止するていうことですか？
それは悲しいです。
・ListBox1では、顧客ＮＯ、ＴＥＬ、名前、住所が表示されています。 これは絶対欲しいです。欲しいものは欲しいです ٩(◦`꒳´◦)۶
だって、電話番号欲しいときあるもん、住所変更したよ〜連絡来ることもあるもん。
元の表示項目に戻してほしいです。
勝手ながら、自分で直そうと思ってコードとにらめっこしたんですが。
Private Sub TextBox1_Change() 'テキストＢＯＸに値入れると検索結果得る
Dim r As Range
Dim s1 As String
Dim s2 As String
With ListBox1
.RowSource = ""
.ColumnHeads = False
End With
With ListBox2
.RowSource = ""
.ColumnHeads = False
End With
ListBox3.Clear
With Sheets("顧客") '範囲
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 14)
End With
s1 = StrConv(TextBox1.Value, vbUpperCase) '文字列を大文字に変換
s2 = StrConv(TextBox1.Value, vbLowerCase) '文字列を小文字に変換
'フィルターオプションの条件、縦に並べると OR 条件 ANDはできない
With Sheets("作業") 'フィルター結果を作業シートにコピーする
.UsedRange.ClearContents
.Range("A1").Value = Sheets("顧客").Range("E1").Value '条件タイトル
'大文字小文字等で検索したい場合は設定
.Range("A2").Value = "*" & StrConv(s1, vbWide) & "*" '半角文字を全角文字に変換
.Range("A3").Value = "*" & StrConv(s1, vbNarrow) & "*" '全角文字を半角文字に変換
.Range("A4").Value = "*" & StrConv(s2, vbWide) & "*"
.Range("A5").Value = "*" & StrConv(s2, vbNarrow) & "*"
'.Range("C1").Value = .Range("A1").Value '抽出１列目タイトル
'.Range("D1").Value = Sheets("顧客").Range("M1").Value '抽出２列目タイトル
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:A5"), CopyToRange:=.Range("C1"), Unique:=False
If Not IsEmpty(.Range("C2")) Then
With .Range("C1").CurrentRegion
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox1.ColumnHeads = True
End With
End If
End With
End Sub
↑上のコード2行直したら、欲しい表示は出たんですが、
↓下のコードがエラーばかりでどうしょうもありません 売上の処理コードと見受けられますが
作業シートのＰ列までが、顧客のデーターを使ってるので、 Ｒ列から売上の作業開始しようとしたんですが・・・
売り上げの抽出条件のコードをもう少し調べてみます 。・ﾟ・(pゝД；｀q)・ﾟ・
Private Sub ListBox1_Click()
Dim r As Range
With ListBox2
.RowSource = ""
.ColumnHeads = False
End With
ListBox3.Clear
With Sheets("売上")
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
End With
With Sheets("作業")
.Range("R1").CurrentRegion.ClearContents
.Range("S1").Value = Sheets("売上").Range("D1").Value '抽出タイトル
.Range("S2").Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("S1:S2"), CopyToRange:=.Range("R1"), Unique:=False
If Not IsEmpty(.Range("R2")) Then
.Range("R1").CurrentRegion.Sort Order1:=xlAscending, Key1:=.Columns("L"), Order2:=xlDescending, Key2:=.Columns("I"), Header:=xlYes
.Range("R1").CurrentRegion.RemoveDuplicates Columns:=Array(5, 8), Header:=xlYes
With .Range("H2").CurrentRegion
ListBox2.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox2.ColumnHeads = True
ListBox3.List = Array(ListBox1.List(ListBox1.ListIndex, 1))
End With
End If
End With
End Sub
（ひなの ） 2016/07/02(土) 08:45
（β） 様
説明不足で申し訳ありません。
あいまい検索のフォームは 請求書に書き出すためのもだけではありません。
使用目的 1.請求書に書き出すための検索 2.問い合わせ来る時の資料として見る ・住所変更 ・電話変更 ・私いつもなにとったけ？ ・毎回毎回トラブルしやがって 3.注意項目は見逃さないために リストボックスを目立たせている。 ・トラブル記載内容 ・お宅で買ったみかんいつも傷ついてるぞ、半額にしろ、さもなきゃ全部返す ・みかん 甘くないぞ ただにしろ ・注文と間違ってるぞ、菓子もって詫びれに来い
トラブルが多いお客は記載内容が長いので、リストボックス1に表示させると、見づらいです
ただでさえ、スクロールは手動ですしね。
こういう悪意がある、クレーマーは正直商品を売りたくないのです。
ハッキリと「あなたにきょう品売りたくないからよそで買って」とも言えないですしね。
なので、トラブル内容によって、そのクレーマーの購入全ての商品は永遠に「欠品」になります。
こういう方々の応答もテキパキしないといけないし、「欠品です」と言い切るデーターがほしいので、
リストボックス3は必要不可欠です。なぜなら、ひなの は 全部覚えきる脳みそがないから、ただそれだけです σ(馬ﾟдﾟ鹿)☆
売上シートの件は今大事なことを気付いた。ちょっと考えます。
（ひなの ） 2016/07/02(土) 09:12
レス入れ違いになりました。 とりあえず、用意していたメモをアップします。
>>売上シートのデータをすべて格納してるはず （今回の質問）
アップしたコードは（CommandButton1クリックトリガーかTextBox1入力トリガーかは別にして）
あいまい検索用文字列入力 -> ListBox1 の顧客リスト -> 顧客選択で自動的に ListBox2 に該当購入履歴（のみ）とListBox3に注意書き。
こんな流れでした。
そうではなく、あくまで ListBox2 には、選択したデータを別途、転記目的もあって、【すべて】の売り上げデータにしなければいけなかったんですね。
ただ、ListBoxの列非表示はできますが、行非表示はできません。
なので、
あいまい検索用文字列入力 -> ListBox1 の顧客リスト -> 顧客選択で自動的に 該当売上データすべてをListBox2に表示 ->ListBox2 選択により ListBox3に注意書きを表示するとともに、ListBox4(新設）に購入履歴を表示。
こうすることになります。
そのようにしたコード、手元にできていますので、必要なら、いつでもアップします。 （ListBox1のリストは顧客シート〜の抽出のままにしてありますが）
（β） 2016/07/02(土) 09:22
ありがとうございます。 夕方仕事から戻ったらまた、見直してみますね 言われたことを検証してみます。
（ひなの ） 2016/07/02(土) 09:29
↑でふれた新しいバージョンのコード、今動かしてみましたが、ListBox3の注意書きとListBox4の購入履歴は ListBox2のクリックではなく ListBox1のクリック時点で表示したほうがいいですね。 (ListBox2のどの行を選んでも、ListBox3とListBox4はかわらないということに気が付きました）
とりあえず 新しいバージョンコードをアップしておきます。
Private Sub UserForm_Initialize()
'ListBox1の中身は注意書き含んだ２列だけど、表示は１列のみ
'Initializeでは特段の設定は不要
With ListBox2
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = 11
.ColumnWidths = "0;0;0;0;30;80;0;20;0;50;30"
End With
With ListBox4
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = 11
.ColumnWidths = "0;0;0;0;30;80;0;20;0;50;30"
End With
End Sub
Private Sub TextBox1_Change()
Dim r As Range
Dim s1 As String
Dim s2 As String
With ListBox1
.RowSource = ""
.ColumnHeads = False
End With
ResetList
With Sheets("顧客") '範囲
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 14)
End With
s1 = StrConv(TextBox1.Value, vbUpperCase) '文字列を大文字に変換
s2 = StrConv(TextBox1.Value, vbLowerCase) '文字列を小文字に変換
'フィルターオプションの条件、縦に並べると OR 条件 ANDはできない
With Sheets("作業") 'フィルター結果を作業シートにコピーする
.UsedRange.ClearContents
.Range("A1").Value = Sheets("顧客").Range("E1").Value '条件タイトル
'大文字小文字等で検索したい場合は設定
.Range("A2").Value = "*" & StrConv(s1, vbWide) & "*" '半角文字を全角文字に変換
.Range("A3").Value = "*" & StrConv(s1, vbNarrow) & "*" '全角文字を半角文字に変換
.Range("A4").Value = "*" & StrConv(s2, vbWide) & "*"
.Range("A5").Value = "*" & StrConv(s2, vbNarrow) & "*"
.Range("C1").Value = .Range("A1").Value '抽出１列目タイトル
.Range("D1").Value = Sheets("顧客").Range("M1").Value '抽出２列目タイトル
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A1:A5"), CopyToRange:=.Range("C1:D1"), Unique:=False
If Not IsEmpty(.Range("C2")) Then
With .Range("C1").CurrentRegion
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox1.ColumnHeads = True
End With
End If
End With
End Sub
Private Sub ListBox1_Click()
Dim r As Range
ResetList
With Sheets("売上")
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
End With
With Sheets("作業")
.Range("H1").CurrentRegion.ClearContents
.Range("T1").CurrentRegion.ClearContents
.Range("F1").Value = Sheets("売上").Range("D1").Value '抽出タイトル
.Range("F2").Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("F1:F2"), CopyToRange:=.Range("H1"), Unique:=False
If Not IsEmpty(.Range("H2")) Then
.Range("H1").CurrentRegion.Copy .Range("T1")
.Range("T1").CurrentRegion.Sort Order1:=xlAscending, Key1:=.Columns("X"), Order2:=xlDescending, Key2:=.Columns("U"), Header:=xlYes
.Range("T1").CurrentRegion.RemoveDuplicates Columns:=Array(5, 8), Header:=xlYes
With .Range("H1").CurrentRegion
ListBox2.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox2.ColumnHeads = True
End With
With .Range("T1").CurrentRegion
ListBox4.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox4.ColumnHeads = True
ListBox3.List = Array(ListBox1.List(ListBox1.ListIndex, 1))
End With
End If
End With
End Sub
Private Sub ResetList()
With ListBox2
.RowSource = ""
.ColumnHeads = False
End With
ListBox3.Clear
With ListBox4
.RowSource = ""
.ColumnHeads = False
End With
End Sub
（β） 2016/07/02(土) 09:37
ひなのさんがアップされたコードをつらつら眺めていました。 勝手に、こちらが仕様を変えているわけですが、特に ListBox1 は 顧客の選択とListBox3用の注意を【隠し列】として持っているだけで
CommandButton2_Click (請求書シートへの書き込み）のことは全く考慮していません。
とりあえず、それは抜きで確認お願いします。
（β） 2016/07/02(土) 20:10
今戻りました。
すみません、ありがとうございます。検証して、返事できるのは月曜日になりそうです。
少しお時間下さい （〃⌒ー⌒〃）
（ひなの ） 2016/07/02(土) 23:30
↑を完全に新しいフォーム使っての検証になりますので、
フォームの使用は
テキストボックス
リストボックス 1〜 4
Change イベント使ってますので コンボボタンいらないですものね。
でよろしいでしょうか？
何も表示されません、コードもそのままコピペーだけなんですが。
何でだろう ？
（ひなの ） 2016/07/04(月) 08:10
えっっと・・・
TextBox1 には なにをいれましたか？ 全角の ひ とか？ シート上でもテキストボックス上でも同じですけど、全角の ひ とタイプした段階では、まだ入力されていません。 そのあと エンターや、タブ や 別コントロールの選択等で、はじめて 確定され、入力されますね。
（半角文字なら タイプが即入力）
Changeイベントは入力されて初めて反応しますね。 もともとのコマンドボタン方式では ひ といれてまだ確定していない、それがコマンドボタンを押すことで確定して TextBox1のValueにおさめられ、CommandButton_Click で値参照ができていたんですが、今回、Changeイベントにしましたので ひ といれたあと、エンターしてみてください。
（β） 2016/07/04(月) 14:52
もう１つの反応しない可能性は、そのテキストボックスの名前が TextBox1 ではないとか？
（β） 2016/07/04(月) 16:00
すみません。私ではコードの読解はできないので、
現在ＵＰされているコードでは、検索前のリストボックスの中は空欄になっています。
これを値表示させるようにできませんか？
とりあえず、値は正確に入ってるかどうかを確認したいです。
◆検証結果 あいまい検索は 検索することはできます。 ただ、ListBox1 クリック では 反応しません。何しても空欄のままなので、 どうすることもできません。
◆疑問 行は非表示できないことはわかりました。 では、検索結果を作業シートに書き出して、不要な行を削除する、 ListBox の値は 作業シートから拾えばできそう？
http://www.atmarkit.co.jp/ait/articles/1501/30/news038.html
こちらでは重複しないデーターを取り出せてました。
私の設定条件が複雑すぎたのでしょうか？
だから、コード作成が困難しているとか・・・・・・
（ひなの ） 2016/07/04(月) 20:59
レスを書きこんでいる間に、ひなの さんの編集レスがアップされたようですね。
とりあえず、書きこんだレスをそのままアップします。
少しポイントというか、不具合（？）も含めて整理しましょう。
>>ただ、ListBox1 クリック では 反応しません
あぁ、そちらでしたか。 で、ListBox1 を選んでも、ListBox2,3,4にはなにも９表示されないということですね。 そうなるケースがあるかどうか、チェックしてみます。
>> では、検索結果を作業シートに書き出して、不要な行を削除する、 >> ListBox の値は 作業シートから拾えばできそうな気がします。
ListBox4については、アップしたコードでは、まさに、そうしています。 私がコメントしたのは、ListBox1のことで、ひなのさんのコメントの中で、どこかに 顧客はすべてリスト内に 持っておいて、あいまい検索でヒットしたものだけを【表示】したいというところがあったように思いましたので。 私の勘違いだったかな。であれば放念ください。
>> Dictionaryでは重複しないデーターを取り出せることは、よねさんの部屋で見つけましたが。 >>ここに出したら、また怒られるのと、
だれも怒らないと思いますが？ Dictionaryでやりますか？構いませんけど。 ただ、エクセル標準機能のほうが、コードを見たときに ひなの さんがわかりやすいかなと思ったんです。 β自身は、基本的には、なんでもかんでも Dictionaryで、ちゃちゃちゃっと処理する人です。
ただし、Dictionary処理結果は、基本は、List に格納します。RowSourceは使いません。 ということは、リストボックスの一番上のタイトル行が（そのままでは）表示できないということになります。 でも、これは、たとえば、リストボックスの上にラベルを列数分、場所や長さをあわせて配置して、そのキャプションで 項目名を表示するという方法はありますね。（必要な場合、βはそうしています）
>>コードで作動できてますが、フォームで表示列数を追加できないのが悲しい。
この意味が、ちょっとわからないのですが？ 具体的には、どんな不具合ですか？
で、次に。
>>こちらでは重複しないデーターを取り出せてました。
この指摘もよくわからないところです。 βのコードでは、重複データの削除ができていないということですか？
>>私の設定条件が複雑すぎたのでしょうか？ >>だから、コード作成が困難しているとか・・・・・・
いやいや、きわめてシンプルだと思います。 そうではなく、最初は、どういった手順でどんな指定をして、どんな結果がどこにでてほしいのか、 それを確認するために、たとえばのサンプルを提示するというまだるっこしいことをしているので 時間がかかっているだけだと思ってますが。
★とにかく 「反応しない」というところをチェックしてみます。こちらでは、問題なく、サクサク結果が出ていますので。
（β） 2016/07/04(月) 21:27
↑でこめんとしたように、こちらではサクサク動いています。 で、同じコードを使って、そちらでは『反応しない』とすれば、おそらく原因は１つだけ。 データ（顧客シート、売上シート）が違うということだと思います。 たとえば 顧客シートから抽出されたListBox1 から (株)ひなの を選んだとします。 選ばれた (株)ひなの で、売上シートの D列を絞り込みますが、ここに (株)ひなの がなければ ListBox2,3,4 ともに 空白になりますので 「反応していない」ように見えますね。
あぁ、それと
>>現在ＵＰされているコードでは、検索前のリストボックスの中は空欄になっています。 >>これを値表示させるようにできませんか？
ListBox1 のことですか？ そうですね、そちらのコードでは、Initializeで RowSourceを与えていましたね。 βがアップしたのは空白にしています。ここは、あとでなんとでもなりますので、今は、まず、動きが そちらの意図にあっているかどうかを確認してください。
（β） 2016/07/04(月) 21:50
設定条件がシンプルですね、それを聞いてあんしました。
コードは、特に気にしていません (；¬д¬)
あとで、範囲やシート名を編集するだけで使いまわしするなら、全然ＯＫです。
というと、言葉での受け取り意味がボタンのかけ間違いのようになっているのかな？
≫あいまい検索でヒットしたものだけを【表示】したいというところがあったように思いましたので。
≫ >>こちらでは重複しないデーターを取り出せてました。 すみません、これは勘違いです。聞き流してください。
もう一回（β）様コードと説明をもう一度読んで、 再検討して、問題点をわかり易く、書きますね。
現在では、私ももやもやしていて、何が正しいのかはわからなくなっています。 整理整頓が必要です。
もう少しお時間下さい。 （ひなの ） 2016/07/04(月) 22:15
ListBox1 のことですか？
全部です ListBox1 〜 ListBox4 です。
なので、何が間違えで、何が正しいのか、探せていないでします。
最少に全部出しておけば、検索値がないと空欄になるなら、「あ検索地がないのね」と気づくんですが・・・・
（ひなの ） 2016/07/04(月) 22:17
>>全部です ListBox1 〜 ListBox4 です。
確かに、そういった構えでもいいかもしれませんね。 あるいは、空っぽの時には、なにか、「空っぽになったよ」と、そうわかるようにしたほうがいいかもしれませんね。
ただ、ListBox3 は別ですね。選ばれた顧客の注意点で、まだ、どの顧客かは選ばれていないわけですから。
いずれにしても、売上シートの顧客名が、顧客シートに登録されている顧客名になっているかどうかの確認はお願いしますね。
（β） 2016/07/04(月) 22:26
大変申し訳ございません ＿○／|＿
またわたくしの、ドジのせいです。
（β）様の完璧のコードにイチャモンつけるとは、謝るしかありません。
コードの結果がうまく表せなかったのは 新データーで試した時に
コピペ の時に 一行ずつ ずれていました。 悲しい出来事です。
本当に、本当に、すみませんでした。
◆疑問です。
ListBox2 を 消して ListBox4 だけを使うと、不都合生みますか？
（ひなの ） 2016/07/04(月) 22:56
>>ListBox2 を 消して ListBox4 だけを使うと、不都合生みますか？
アップしたコードでは ListBox2 は表示のみで、ListBox1での選択で、ListBox2,3,4 に書きこんでいます。 ですから ListBox2 が不要なら それを削除するとともに、コード内でListBox2に対して処理しているところを 削除すればＯＫですが？
それはそれとして。
アップしたコードを検証いただく前に改訂版をアップしたりしていますので、ひなのさんも困惑？
コメントしたように、処理結果が、そちらの要件通りかということを確認いただくためと 操作性として、たとえば TexyBoxの入力起動がいいのか、最初にそちらでやっていたCommandButton起動がいいのかを 比較いただく目的です。
起動は、この方式がいいねとか、最初にまず、すべてのデータをリストに表示しておいたほうがいいねとかいったことは 処理ロジック検証ＯＫになれば、最後になんとでも変更できます。
ということで、またまた困惑されるかもしれませんが、アップ済みの仕様のまま、
・ListBox1 は、後々、請求書等に顧客情報を転記する目的もあるので、リスト内には顧客シートの項目をすべて保持。 ・表示は、当初、そちらでやっておられた、ColumnWidth で調整。 ・ListBoxが抽出前の空っぽなのか、マッチしない検索語を入れた結果のからっぽなのかを視覚的に区別するために 後者の場合は、ListBoxの背景色を赤にする。 ・アップしたコードでは作業シートの各使用領域を固定で扱っていましたが、売上シートや顧客シートのリストレイアウト（れｙ巣数） の増減時に、コード変更が煩雑になるので、先頭で それぞれの列数を Constで規定。コードは、それを参照して 作業シートのしかるべき領域を使用。
こんな改訂をいれたものをアップしておきますね。
Dim posCt1 As Range Dim posList1 As Range Dim posCt2 As Range Dim posList2 As Range Dim posList4 As Range Const COLS売上 As Long = 11 Const COLS顧客 As Long = 14 Dim orgBack As Long
Private Sub UserForm_Initialize()
With ListBox1
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = COLS顧客
.ColumnWidths = "30;90;0;0;150;80;200;0;0;0;0;0;0;0"
.BoundColumn = 5
orgBack = .BackColor
End With
With ListBox2
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = COLS売上
.ColumnWidths = "0;0;0;0;30;80;0;20;0;50;30"
End With
With ListBox4
'リストBOXの中の列数と↓ここの列数が異なると実行後エラーになる
.ColumnCount = COLS売上
.ColumnWidths = "0;0;0;0;30;80;0;20;0;50;30"
End With
With Sheets("作業")
Set posCt1 = .Range("A1") 'ListBox1用抽出条件領域
Set posList1 = posCt1.Offset(, 2) 'ListBox1用リスト領域
Set posCt2 = posList1.Offset(, COLS顧客 + 1) 'ListBox2用抽出条件領域
Set posList2 = posCt2.Offset(, 2) 'ListBox2用リスト領域
Set posList4 = posList2.Offset(, COLS売上 + 1) 'ListBox4用リスト領域
End With
End Sub
Private Sub TextBox1_Change()
Dim r As Range
Dim s1 As String
Dim s2 As String
With ListBox1
.RowSource = ""
.ColumnHeads = False
.BackColor = orgBack
End With
ResetList
With Sheets("顧客") '範囲
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 14)
End With
s1 = StrConv(TextBox1.Value, vbUpperCase) '文字列を大文字に変換
s2 = StrConv(TextBox1.Value, vbLowerCase) '文字列を小文字に変換
'フィルターオプションの条件、縦に並べると OR 条件 ANDはできない
With Sheets("作業") 'フィルター結果を作業シートにコピーする
.UsedRange.ClearContents
posCt1.Value = Sheets("顧客").Range("E1").Value '条件タイトル
'大文字小文字等で検索したい場合は設定
posCt1.Cells(2).Value = "*" & StrConv(s1, vbWide) & "*" '半角文字を全角文字に変換
posCt1.Cells(3).Value = "*" & StrConv(s1, vbNarrow) & "*" '全角文字を半角文字に変換
posCt1.Cells(4).Value = "*" & StrConv(s2, vbWide) & "*"
posCt1.Cells(5).Value = "*" & StrConv(s2, vbNarrow) & "*"
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=posCt1.CurrentRegion, CopyToRange:=posList1, Unique:=False
If Not IsEmpty(posList1.Cells(2, 1)) Then
With posList1.CurrentRegion
ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox1.ColumnHeads = True
End With
Else
ListBox1.BackColor = vbRed
End If
End With
End Sub
Private Sub ListBox1_Click()
Dim r As Range
ResetList
With Sheets("売上")
Set r = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
End With
posList2.CurrentRegion.ClearContents
posList4.CurrentRegion.ClearContents
posCt2.Cells(1).Value = Sheets("売上").Range("D1").Value '抽出タイトル
posCt2.Cells(2).Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
r.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=posCt2.CurrentRegion, CopyToRange:=posList2, Unique:=False
If Not IsEmpty(posList2.Cells(2, 1)) Then
posList2.CurrentRegion.Copy posList4
posList4.CurrentRegion.Sort Order1:=xlAscending, Key1:=posList4.Columns(5), Order2:=xlDescending, Key2:=posList4.Columns(2), Header:=xlYes
posList4.CurrentRegion.RemoveDuplicates Columns:=Array(5, 8), Header:=xlYes
With posList2.CurrentRegion
ListBox2.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox2.ColumnHeads = True
End With
With posList4.CurrentRegion
ListBox4.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True)
ListBox4.ColumnHeads = True
ListBox3.List = Array(ListBox1.List(ListBox1.ListIndex, 12))
End With
Else
ListBox2.BackColor = vbRed
ListBox3.BackColor = vbRed
ListBox4.BackColor = vbRed
End If
End Sub
Private Sub ResetList()
With ListBox2
.RowSource = ""
.ColumnHeads = False
.BackColor = orgBack
End With
With ListBox3
.Clear
.BackColor = orgBack
End With
With ListBox4
.RowSource = ""
.ColumnHeads = False
.BackColor = orgBack
End With
End Sub
（β） 2016/07/05(火) 10:59
（β） 様
面白いアイディアをありがとうございます。
これはこれで、面白いので、使ってみようと思います。
改善点
顧客空欄ではなく、エクセルデーターシートの情報を出してほしいです。
売り上げを注意事項は ”赤でＯＫです。” ＋コメントがあると便利ですね。 「売上なし」「トラブルなし」とかね
これは自分で入れてみます。
起動時間 わかりません。現在のデーター50行しかないので、処理速度は同じに思います。 シートいえば、ボタンクリックのほうが若干遅いのかもです。
（ひなの ） 2016/07/05(火) 17:42
>>顧客空欄ではなく、エクセルデーターシートの情報を出してほしいです。
例によって、βは読解力がプアなので、この意味するところが・・？？？です。 どのListBoxのことを言っているのかはわかりませんが、ListBox3 なら、そうしています。
で、最初に表示された時点でのListBox1 のことであれば、それは、最後にちょこちょこっと変更しますのでと 申し上げたと思いますが。 もし、この構成で、おおむねＯＫということで、かつ、言っておられるのが ListBox1 のことなら、そういう手当てをしたコードを アップしますけど。
>>起動時間
処理時間のことではありません。処理するタイミングのことです。 操作者によっては、何かを選択する。あるいは 何かを入力する。 自分が選択したかったものが確かにクリックされて色が反転している、あるいは自分が指定したい文字列が 確かに、正しく入力された。 それをしっかりと確かめてから、おもむろに、CommandButtonを押すのを好む人もいるでしょうし、 それは、まだるっこしいので、入力したら、あるいはクリックしたら、即、処理をしてほしいと、そう思う人もいるでしょう。
ひなの さんのところの皆さんが、どちらを好まれるかで、仕様を確定させたらいいという意味です。
ところで、もし、CommandButton をクリックすることで処理する仕様の場合、考慮が必要なところがでてきます。
・検索文字を入力（たとえば ひ） ・ボタンクリック ・結果が表示される（ひなのカンパニーとか株式会社ひなの とか）
この状態で、別の検索文字を入力。（たとえば β） でも、前のひなのカンパニーや株式会社ひなのの表示がのこっていますね。
ここだけを見た人は、あれ？？ 検索文字が β で、なぜ、一覧に ひなのカンパニー や株式会社ひなのが 表示されているんだろう？？ プログラムの不具合だ！！！！
と、騒ぐかもしれませんね。 こうならないような仕掛けが、別途必要になりますね。
（β） 2016/07/05(火) 19:20
で、もし、ユーザーフォーム時点で ListBox1 に顧客シートにある顧客をすべて表示しておきたいということなら
Initialize プロシジャの End Sub の上に
TextBox1_Change
これを１行追加してください。
（β） 2016/07/05(火) 19:23
・表示は TextBox1_Change であってます。
・検索は CommandButton でも Change でもどちらでも大丈夫です。 ラベルで説明入れますので問題ないです。 聞いても「まかせる」と答えるに決まってます。 (；ーдー)
◆現在のコード 欲しい結果が完璧に、表示されています。
◆欲張ると 現在。ListBox2 と ListBox4 の売上の検索結果で、 商品番号「A01〜Z01」と「000〜005」番の物があります。 このアルファベット以外のもの「0」から始まる番号は検索に引っかからないようにすることは 可能でしょうか？
「0」から始まるのは送料や手数料とか経費関係のもので毎回違う金額なので、
非常に、じゃまです。 難しなら、並び替えを考えなければ ・・・・
（ひなの ） 2016/07/05(火) 21:38
>>このアルファベット以外のもの「0」から始まる番号は検索に引っかからないようにする
前に、フィルターオプションの抽出条件は、基本、列タイトルと、抽出文字列の組み合わせだけど 列タイトルを空白にして、条件欄に、抽出元のリストの２行目に対する数式を入れることもできるとコメントしましたね。
その方式でやりましょうか。
Private Sub ListBox1_Click()
このなかの
posCt2.Cells(1).Value = Sheets("売上").Range("D1").Value '抽出タイトル
posCt2.Cells(2).Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
これを消して、そのかわりに
posCt2.Cells(1).ClearContents '条件を数式で与えるためタイトル文字列を空白に
posCt2.Cells(2).Formula = "=AND(売上!D2=""" & ListBox1.Value & """,LEFT(売上!E2,1)<>""0"")" 'リスト領域2行目に対する数式
これをいれて試してください。
（β） 2016/07/05(火) 22:23
もちろん、タイトル文字列と抽出条件を横に並べて AND抽出をすることもできます。
その場合は、Initializeの
Set posList2 = posCt2.Offset(, 2) 'ListBox2用リスト領域
これを
Set posList2 = posCt2.Offset(, 3) 'ListBox2用リスト領域
にしたうえで、Private Sub ListBox1_Click() の中の
posCt2.Cells(1).Value = Sheets("売上").Range("D1").Value '抽出タイトル
posCt2.Cells(2).Value = ListBox1.Value '抽出条件（ListBox1で選ばれた１列目位の値）
これは、そのまま残し、その下に
posCt2.Cells(1, 2).Value = Sheets("売上").Range("E1").Value '抽出タイトル
posCt2.Cells(2, 2).Value = "<>0*" '抽出条件 0 ではじまらないもの
これを追加。
数式方式か、項目AND方式かは、ひなのさんのわかりやすい方法を採用してください。
（β） 2016/07/05(火) 22:51
（β） 様 ありがとうございます。これで、欲しい条件がすべて備え付けられました。 長かったですね。私のせいで途中迷路に迷い込ん見ましたね。 なんとあれ、やっと一息です。 。・ﾟ・(pゝД；｀q)・ﾟ・ ホントにありがとうございます。 ｍ(＿ ＿)ｍ
↓はコードのことで教えてくださいませんか？これは今後のために参考にしたいです。 よろしくお願いします。
≫ListBox2 が不要なら それを削除するとともに、コード内でListBox2に対して処理しているところを ≫削除すればＯＫですが？
Q.ListBox2を削除可能？ 前回のコメントでは、ListBox2は表示のみとのことですが、
If Not IsEmpty(posList2.Cells(2, 1)) Then
posList2.CurrentRegion.Copy posList4
ListBox2 のデーターをさらに絞って ListBox4 にコピーするコードではないのでしょうか？
≫posCt2.Cells(1, 2).Value = Sheets("売上").Range("E1").Value '抽出タイトル
≫posCt2.Cells(2, 2).Value = "<>0*" '抽出条件 0 ではじまらないもの
ちょっと思ったんですが、違ったらすみません。
Q.検出条件の設定コードについて 「抽出条件 0 ではじまらないもの」を検出条件をこのコードで設定できるてことは。 同じ要領で、フィルターで絞った条件も、これに変換できるんですか？
（ひなの ） 2016/07/06(水) 21:01
>>Q.ListBox2を削除可能？
確かに、posList2 は 「ListBox2用のリスト作業域の先頭のセル（現行コードではU1になってます）」ですが あくまで、作業用の領域であって、ここに何かを書きこんだからといって、ListBox2 に直接作用するということはありません。
１．ListBox1内の顧客のどれかをクリック --> 売上シートから指定顧客のデータを抽出して「ListBox2用のリスト作業域」に書きこむ。
そのあと、
２．その領域の内容を ListBox2のROWSOURCEに設定 ３．その領域の内容を、そのまま ListBox4用の作業域（posList4を左上隅とした領域、現行コードではAG1)にコピーした上で その領域で重複の削除を行い、ListBox4のROWSOURCEに設定。 ４．ListBox1内の選択顧客の注意書きをListBox3のセット
この３つを【並行的】に行っています。 ですから、２．の部分のコードだけが不要になります。１．は ３．のために必要です。
>>Q.検出条件の設定コードについて
例によって理解力がプアなβです。 具体的に、こんな条件の場合 といってもらえれば、その条件で抽出するためには、こんな設定方法があるというアドバイスはできますが。 あるいは、とにかくフィルターオプションの抽出機能は多彩ですので、ネットで【フィルターオプション】あたりで検索した結果の わかりやすそうなページの例を、実際に手を動かして体験してみる。そうすれば、あぁ、こうしたらいいんだということが わかってくると思います。
（β） 2016/07/07(木) 08:29
（β） 様
ありがとうございました。 調べて勉強してみます。
また何かありましたら、懲りずにまた教えていただけましたらうれしいです。 本当にありがとうございます。おかげさまで仕事がだいぶ時間短縮できました。 ｍ(＿ ＿)ｍ
（ひなの ） 2016/07/07(木) 09:01
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.