この様な経験された事ありますか？

質問

お尋ねします
ユーザーフォームを使い客先データリスト（データ数：500件）から
目的の客先を抽出するのですが200件までしか抽出してくれません
抽出件数に制限があるのでしょうか？
セルa1：Ｎｏ、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：ペンティアム４、240GHｚ、メモリー512MB　RAMです
OS：XP（Pro）office2000（Pro）のエクセルを使用
素人考えでメモリを消費しすぎていて表示されないのかなと思っているのですが
この様な経験をされた方、良い方法がありましたら、アドバイスお願いします。

回答No.2

Wendy02 · ベストアンサー

こんばんは。

見させていただきましたが、いくつか思う点があります。
全体が見せられていないので、正確には言えませんが、　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("エンドユーザー", "日本*"))

販売店名　亜細亜の　エンドユーザー　最初の二文字が「日本」　というデータを探す、という内容です。

なお、私個人の作リ方ですと、販売店名＋顧客データのデータソースを、丸出しにしません。このコードでは、シートは、非表示でも、ユーザーフォームに出力できます。

お礼

ありがとうございます
サブルーチンの
CopyToRange:=mySh.Range("F1") ', Unique:=True
の所をE1に書き換えれば良いのですね
解決いたしました。

補足

大変、細かくお教えいただきありがとうございます。
新しいマクロの記録でエクセルが自動作成してくれた
マクロに少し手を加えただけで満足していました。
こう言う方法もあるのかと大変参考になりました。
　早速コピーさせていただき実行しましたが
抽出はするのですがListBox1に1列目のNoが表示されるのですが2列目のエンドユーザを表示させるのには
どこを書き換えれば良いのでしょうか
よろしくお願いいたします。

回答No.1

papayuka

提示されたソースとListBox1にどのような関わりがあるか読み取れませんが、、、

販売店名が重複しているのでは？
Unique:=True で重複レコードを無視してますので。

補足

ありがとうございます
UserForm1の中にListBox1がありシート上のCommandButtonで表示させています
Sub ユーザフォーム表示()
　UserForm1.Show
End Sub
販売店が販売した先がエンドユーザとしていますが
重複しない販売店数だけ表示させ、その中から選択させるようにしています。