Ｐａｇｅ 206 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼Listboxで同じデータは表示しないようにするには かまさん 02/10/12(土) 22:28 ┣Re:Listboxで同じデータは表示しないようにするには ichinose 02/10/13(日) 0:02 ┃ ┗Re:Listboxで同じデータは表示しないようにするには かまさん 02/10/15(火) 5:40 ┃ ┗うまくいきませんか？ ichinose 02/10/15(火) 7:59 ┃ ┗うまくいきました。 かまさん 02/10/15(火) 21:55 ┗Re:Listboxで同じデータは表示しないようにするには ジャッキー 02/10/13(日) 9:25 ─────────────────────────────────────── ■題名 ： Listboxで同じデータは表示しないようにするには ■名前 ： かまさん <km_yamaguchi@ybb.ne.jp> ■日付 ： 02/10/12(土) 22:28 -------------------------------------------------------------------------
| Listboxで表示させるデータをプロパティのRowsouceで例えばB2:B200 と指定していますがこの中に重複データがいくつかあります。 重複データは1個づつ表示するには何か方法がありますか？ |
| ▼かまさん さん： こんばんは。 >Listboxで表示させるデータをプロパティのRowsouceで例えばB2:B200 >と指定していますがこの中に重複データがいくつかあります。 >重複データは1個づつ表示するには何か方法がありますか？ 手順としては､ フィルタを使用して、重複をなくす。別の列にコピー（とりあえず、Ｃ列にしましたが、どこでもいいです） その範囲をリストボックスに設定する '======================================================== Sub Macro1() Load UserForm1 With Range("b1:b200") .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("c1"), Unique:=True End With With UserForm1 If Range("c2").Value <> "" Then Set rng = Range(Range("c2"), Cells(Range("c65536").End(xlUp).Row, 3)) .ListBox1.List = rng.Value End If .Show End With End Sub で重複ナシでリストボックスに表示できますが・・・。 他にも方法はあるかもしれません。 |
| ▼ichinose さん： ご指導ありがとうございました。ichinoseさんのマクロでは動作しなかったの ですが、「フィルタを使用して、重複をなくす。」というヒントが大変参考に なり、その方法を自動マクロで記録し使いました。 因みに、下記のマクロとなります。尚、このマクロで無駄な箇所がありましたら ご指摘ください。 Sub 部抽出() Range("F1:F300").AdvancedFilter Action:=xlFilterInPlace, Unique:=True Range("F2:F300").Select 'F列で重複した部を除き、S列へコピー Range("S1").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.ShowAllData Range("F1").Select End Sub |
| ▼かまさん さん： おはようございます。 >ご指導ありがとうございました。ichinoseさんのマクロでは動作しなかったの >ですが、「フィルタを使用して、重複をなくす。」というヒントが大変参考に >なり、その方法を自動マクロで記録し使いました。 >因みに、下記のマクロとなります。尚、このマクロで無駄な箇所がありましたら >ご指摘ください。 > >Sub 部抽出() > Range("F1:F300").AdvancedFilter Action:=xlFilterInPlace, Unique:=True > Range("F2:F300").Select 'F列で重複した部を除き、S列へコピー > Range("S1").Select > ActiveSheet.Paste > Application.CutCopyMode = False > ActiveSheet.ShowAllData > Range("F1").Select >End Sub 上記のコードとほぼ同じ動作を下のコードでやってくれるのですが、 With Range("F1:F300") .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("S1"), Unique:=True End With 前回のコードでは､正常に動作しないとの事ですが、 エラーが発生するのですか？、それとも、抽出できないということでしょうか？ 私の方でも再度確認しましたが､正常に作動していますが・・・。 |
| ▼ichinose さん： こんばんわ！1行目のタイトルがブランクだった為うまくどうさしませんでした。 従って、F1：F300をF2：F300としたらうまくいきました。 いろいろとフォローして頂き本当に有難うございました。 >前回のコードでは､正常に動作しないとの事ですが、 >エラーが発生するのですか？、それとも、抽出できないということでしょうか？ >私の方でも再度確認しましたが､正常に作動していますが・・・。 |
| ジャッキーといいます、横から失礼します。 Collectionを使用してみました。 よかったらお試しください。 Private Sub UserForm_Initialize() Dim mCL As Collection Dim CL As Range Dim Lcnt As Long Set mCL = New Collection Lcnt = 0 For Each CL In Range("b1:b200") On Error Resume Next mCL.Add CL.Value, CStr(CL.Value) On Error GoTo 0 If Lcnt + 1 = mCL.Count Then ListBox1.AddItem CL.Value End If Lcnt = mCL.Count Next CL Set mCL = Nothing End Sub はずしていたらすいません。 |