- ベストアンサー
この様な経験された事ありますか?
お尋ねします ユーザーフォームを使い客先データリスト(データ数:500件)から 目的の客先を抽出するのですが200件までしか抽出してくれません 抽出件数に制限があるのでしょうか? セルa1:No、b1:販売店名、c1:エンドユーザ、d1:販売店名、e1、販売店名 VBコードは以下です UserForm1にListBox1があり UserForm1をUserForm1.Showで表示させるとき Private Sub UserForm_Activate() Range("a1:c501").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _ Range("d1:d2"), CopyToRange:=Range("e1:e1"), Unique:=True End Sub としているのですが ListBox1には200件までしか表示されません ListBox1のプロパティの範囲RowSourceにe2:e501としていますのに セルd2には全て表示させるよう*を入力しています 上記だけを試してみると、ちゃんと500件、抽出するのですが実は 一寸大きなアプリケーションソフトの一部で動作させています メニュープログラム:880Kb、サブメニュープログラム:320Kb 本プログラム:1,200Kbが同時に開いています PCはデルでCPU:ペンティアム4、240GHz、メモリー512MB RAMです OS:XP(Pro)office2000(Pro)のエクセルを使用 素人考えでメモリを消費しすぎていて表示されないのかなと思っているのですが この様な経験をされた方、良い方法がありましたら、アドバイスお願いします。
- みんなの回答 (2)
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 見させていただきましたが、いくつか思う点があります。 全体が見せられていないので、正確には言えませんが、 UserForm_Activate() が、今見ている限りだとしたら、もう少し工夫が必要ですね。 >客先データリスト(データ数:500件)から目的の客先を抽出するのですが200件まで >b1:販売店名、c1:エンドユーザ ?客先データリストとは、エンドユーザーのことですか? もし、そうなら、まず、VBAでは、AdvancedFilter の CriteriaRange は、その前に、書き入れるようにさせないといけませんね。それと、CriteriaRange部分は、変数にしたほうがよいです。それは、Criteria は、その書き込む内容によって、エリアのサイズが変えなくてはならないからです。 そして、例えば、初期値に、Set myCritRange = Range("D1:D2") とします。 セルd2には全て表示させるよう*を入力しています でしたら、 D 1 エンドユーザ ←これらは手で入れません。 2 * ← '' となります。#1さんのこ指摘のように、販売店名のユニーク処理をされて出力されています。 以下のコードを見てください。本来は、もう少し、練り込む必要はあると思うのですが、当面の参考にならないでしょうか?それと、ユーザーフォームの場合は、Sheet名を指定したほうがよいです。それから、 >ListBox1のプロパティの範囲RowSourceにe2:e501 出力値は、Criteria部分の余裕を取ったほうがよいです。以下は、F列にしました。 Dim myCrRange As Range Dim mySh As Worksheet Private Sub UserForm_Activate() Set mySh = Worksheets("Sheet3") Set myCrRange = mySh.Range("D1:D2") '出力データは、ちゃんと消さないと次の検索に出てきません。 mySh.Range("F1", mySh.Range("F65536").End(xlUp).Offset(, 2)).ClearContents 'Criteriaへの書き込み myCrRange.Value = WorksheetFunction.Transpose(Array("エンドユーザー", "*")) myFilterExecute myCrRange 'サブルーチンへ ListBox1.ColumnCount = 3 '3列表示 '列が離れすぎていたら、 'ColumnWidths | 30 ; 30 ;30 'などと入れます。 'RowSource よりもListのほうが動きが速い ListBox1.List = mySh.Range(mySh.Range("F1"), mySh.Range("F1").End(xlDown).Offset(, 2)).Value 'ListBox1.RowSource = Range(Range("F1"), Range("F1").End(xlDown).Offset(, 2)).Address End Sub 'サブルーチン Private Sub myFilterExecute(myCrRange As Range) mySh.Range("A1", mySh.Range("A65536").End(xlUp).Offset(, 2)).AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=myCrRange, _ CopyToRange:=mySh.Range("F1") ', Unique:=True End Sub '終了時 Private Sub UserForm_Terminate() Set mySh = Nothing Set myCrRange = Nothing End Sub 以下の部分がキーとなります。 Set myCrRange = mySh.Range("D1:D2") D1:D2 に入れています。 myCrRange.Value = WorksheetFunction.Transpose(Array("エンドユーザー", "*")) ↓ 複合検索する場合。 Set myCrRange = mySh.Range("D1:E2") myCrRange.Columns(1).Value = WorksheetFunction.Transpose(Array("販売店名", "亜細亜")) myCrRange.Columns(2).Value = WorksheetFunction.Transpose(Array("エンドユーザー", "日本*")) 販売店名 亜細亜の エンドユーザー 最初の二文字が「日本」 というデータを探す、という内容です。 なお、私個人の作リ方ですと、販売店名+顧客データのデータソースを、丸出しにしません。このコードでは、シートは、非表示でも、ユーザーフォームに出力できます。
その他の回答 (1)
- papayuka
- ベストアンサー率45% (1388/3066)
提示されたソースとListBox1にどのような関わりがあるか読み取れませんが、、、 販売店名が重複しているのでは? Unique:=True で重複レコードを無視してますので。
補足
ありがとうございます UserForm1の中にListBox1がありシート上のCommandButtonで表示させています Sub ユーザフォーム表示() UserForm1.Show End Sub 販売店が販売した先がエンドユーザとしていますが 重複しない販売店数だけ表示させ、その中から選択させるようにしています。
お礼
ありがとうございます サブルーチンの CopyToRange:=mySh.Range("F1") ', Unique:=True の所をE1に書き換えれば良いのですね 解決いたしました。
補足
大変、細かくお教えいただきありがとうございます。 新しいマクロの記録でエクセルが自動作成してくれた マクロに少し手を加えただけで満足していました。 こう言う方法もあるのかと大変参考になりました。 早速コピーさせていただき実行しましたが 抽出はするのですがListBox1に1列目のNoが表示されるのですが2列目のエンドユーザを表示させるのには どこを書き換えれば良いのでしょうか よろしくお願いいたします。