Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7909 / 13645 ツリー ←次へ | 前へ→

【36010】ユーザーフォームにて検索結果をリストに表すには? エターナル 06/3/18(土) 18:05 質問[未読]
【36030】Re:ユーザーフォームにて検索結果をリスト... かみちゃん 06/3/19(日) 12:18 発言[未読]
【36044】Re:ユーザーフォームにて検索結果をリスト... エターナル 06/3/20(月) 0:18 発言[未読]
【36045】Re:ユーザーフォームにて検索結果をリスト... とおりすがり 06/3/20(月) 7:59 発言[未読]
【36048】Re:ユーザーフォームにて検索結果をリスト... かみちゃん 06/3/20(月) 9:39 発言[未読]
【36053】Re:ユーザーフォームにて検索結果をリスト... エターナル 06/3/20(月) 10:26 発言[未読]
【36066】Re:ユーザーフォームにて検索結果をリスト... かみちゃん 06/3/20(月) 13:13 発言[未読]
【36067】Re:ユーザーフォームにて検索結果をリスト... エターナル 06/3/20(月) 13:26 発言[未読]
【36069】Re:ユーザーフォームにて検索結果をリスト... かみちゃん 06/3/20(月) 13:52 発言[未読]
【36071】Re:ユーザーフォームにて検索結果をリスト... エターナル 06/3/20(月) 14:22 発言[未読]
【36072】Re:ユーザーフォームにて検索結果をリスト... エターナル 06/3/20(月) 14:26 発言[未読]
【36104】Re:ユーザーフォームにて検索結果をリス... kobasan 06/3/20(月) 21:20 発言[未読]
【36106】Re:ユーザーフォームにて検索結果をリス... エターナル 06/3/20(月) 22:34 発言[未読]
【36109】Re:ユーザーフォームにて検索結果をリス... kobasan 06/3/21(火) 0:36 発言[未読]
【36127】Re:ユーザーフォームにて検索結果をリス... エターナル 06/3/21(火) 19:54 発言[未読]
【36128】Re:ユーザーフォームにて検索結果をリス... kobasan 06/3/21(火) 20:14 回答[未読]
【36132】Re:ユーザーフォームにて検索結果をリス... kobasan 06/3/21(火) 21:31 発言[未読]
【36148】Re:ユーザーフォームにて検索結果をリス... エターナル 06/3/22(水) 17:44 お礼[未読]

【36010】ユーザーフォームにて検索結果をリストに...
質問  エターナル  - 06/3/18(土) 18:05 -

引用なし
パスワード
   ユーザーフォームのテキストボックスに検索語を入れてコマンドボタンクリックした後、リストボックスに検索結果を表示したいのですが、過去ログの似たようなものから改造して作ったのですが、実行したらしばらく固まり、強制終了したら、しまいには保存もしてなかったので、ユーザーフォームごと消えました><

UserForm1にTextBox1とCommandButton1とListBox1があります。
検索をかけるデータリストは下記のようになっています。

 A    B    C    D    E    F    G    H ・・・・・ EH
1 社員No 氏名  部署  誕生日 住所  趣味  年齢  委員会   役職
2 100  堀江      1950/9/5 大阪市 剣玉  56   広報    社長
3 101  宮本   営業 1955/1/1 吹田市 麻雀  51  地域交流  部長

テキストボックスに検索語を入れHITした列のA,B,C,D,F,G,EH を
リストボックスに表示させたいのですがどなたかわかる方よろしく
お願いします。

【36030】Re:ユーザーフォームにて検索結果をリス...
発言  かみちゃん  - 06/3/19(日) 12:18 -

引用なし
パスワード
   こんにちは。かみちゃん です。

> 改造して作ったのですが、実行したら

このコードをアップすることはできませんか?

【36044】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 0:18 -

引用なし
パスワード
   No.35469
の過去ログを参考にさせてもらい何時間もかけて、作ったのですが、
実行したら永久ループしたのかわかりませんが、エクセルが固まってしまい、
保存もしていなかった為、消えてしまいました><

【36045】Re:ユーザーフォームにて検索結果をリス...
発言  とおりすがり  - 06/3/20(月) 7:59 -

引用なし
パスワード
   マクロを試行する場合は、バックアップをとって行うか、
サンプルデータのブックを別に作って行うようにしましょう。

ここではかみちゃんさんがサンプルコードをアップしたわけでもないのに

>エクセルが固まってしまい、
>保存もしていなかった為、消えてしまいました><

と書かれてもどうしようもありません。

【36048】Re:ユーザーフォームにて検索結果をリス...
発言  かみちゃん  - 06/3/20(月) 9:39 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>No.35469
>の過去ログを参考にさせてもらい何時間もかけて、作った

[#35469]を参考にどのようなコードにしたのでしょうか?
そのコードをアップすることはやはりできないでしょうか?

>実行したら永久ループしたのかわかりませんが、エクセルが固まってしまい、
>保存もしていなかった為、消えてしまいました><

コードの提示がないのに、このように言われましても、誰も何もすることは難しい
と思います。

【36053】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 10:26 -

引用なし
パスワード
   レス遅くなり申し訳ありません。
前回作ったものと違うのですが、下記のようなものです。
前回はデバッグではエラーにはなりませんでしたが、今回はデバッグの時点でエラー
となります。


Private Sub CommandButton1_Click()
Dim rng As Range, r As Range, rn As Range
Dim vnt As Variant, v, txtList
Dim dicChk As Object
  '
  txtList = Array("")
  With "\db.csv" '←ここがエラーになります。前回はどう記述したか忘れました。
    Set rng = .Range("A1", .Range("G65536"))
         
   End With
  '
  Set dic = CreateObject("Scripting.Dictionary")
  Set dicChk = CreateObject("Scripting.Dictionary")
  '
  For Each v In txtList
  For Each rn In rng.Cells
  For Each r In rn.Resize(1, 3)
    If r.Text Like ("") Then
      If dic.exists(v) Then
        If dicChk.exists(r.Row & v) Then Exit For
        vnt = dic(v)
        ReDim Preserve vnt(UBound(vnt) + 1)
        vnt(UBound(vnt)) = Cells(r.Row, 1).Resize(1, 7).Value
      Else
        ReDim vnt(0 To 0)
        vnt(0) = Cells(r.Row, 1).Resize(1, 7).Value
      End If
      dic(v) = vnt
      dicChk(r.Row & v) = ""
    End If
  Next
  Next
  Next
  '
  TextBox1.List = txtList
  
  ListBox1.ColumnCount = 7  'ListBox1の列は7列にする
  '
  Set dicChk = Nothing
  Set rng = Nothing
  End Sub


Private Sub TextBox1_Change()
  ListBox1.List = Application.Transpose(Application. _
          Transpose(dic(TextBox1.Value)))
End Sub

Private Sub UserForm_Terminate()
  Set dic = Nothing
End Sub

End Sub

【36066】Re:ユーザーフォームにて検索結果をリス...
発言  かみちゃん  - 06/3/20(月) 13:13 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>前回作ったものと違うのですが、下記のようなものです。

前回作ったものと違うというのは、どういう意味でしょうか?
以下のコードは[#35579]を参考にされているということでしょうか?

>Private Sub CommandButton1_Click()
>Dim rng As Range, r As Range, rn As Range
>Dim vnt As Variant, v, txtList
>Dim dicChk As Object
>  '
>  txtList = Array("")
>  With "\db.csv" '←ここがエラーになります。前回はどう記述したか忘れました。
>    Set rng = .Range("A1", .Range("G65536"))
>         
>   End With

txtList = Array("")
With "\db.csv"
この2行が明らかに違います。
txtListの配列に格納する値がないのはなぜですか?
With "\db.csv"
は、シート名ではないでしょうか?

【36067】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 13:26 -

引用なし
パスワード
   >前回作ったものと違うというのは、どういう意味でしょうか?
 前回はデバッグでエラーにはならなかったのですが、
 今回はエラーが出るので、単純に前回とは微妙に違うものです。

>以下のコードは[#35579]を参考にされているということでしょうか?
 そうです。#35579の方と違うとこはコンボボックスを使って検索するのと、
 データのターゲットがシートかどうかというとこだけだったので。

>txtList = Array("")
>With "\db.csv"
>この2行が明らかに違います。
>txtListの配列に格納する値がないのはなぜですか?
 
 txtList = Array("*")  ←これでよろしいのでしょうか?
 
>With "\db.csv"
>は、シート名ではないでしょうか?
いえ、db.csvという別ファイルから検索したいのですが、
フルパスでないといけないのでしょうか?

【36069】Re:ユーザーフォームにて検索結果をリス...
発言  かみちゃん  - 06/3/20(月) 13:52 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>With "\db.csv"
>>は、シート名ではないでしょうか?
>いえ、db.csvという別ファイルから検索したいのですが、
>フルパスでないといけないのでしょうか?

そういうことは、初めて聞きました。
今、質問を読み直しましたが、何をしたいのかがよくわかりません。
再度、したいことを教えてください。

【36071】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 14:22 -

引用なし
パスワード
   エクセル〔シート1〕に、
UserForm1にTextBox1とCommandButton1とListBox1があります。
検索をかけるデータリストは同フォルダのdb.csvというファイルで下記のようになっています。AからEHまで、空白を含めデータがあります。

 A    B    C    D    E    F    G    H ・・・・・ EH
1 社員No 氏名  部署  誕生日 住所  趣味  年齢  委員会   役職
2 100  堀江      1950/9/5 大阪市 剣玉  56   広報    社長
3 101  宮本   営業 1955/1/1 吹田市 麻雀  51  地域交流  部長
以下100列位あります。

テキストボックスに検索語を入れ(ターゲット行はABCDEFGまで)
一致する条件があればListBox1にA,B,C,D,E,F,G,EHの値を
リストボックスに表示させたいのです。

例えばテキストボックスに大阪と入れコマンドボタンを実行すると、
リストボックスに
100 堀江  1950/9/5 大阪市 剣玉 56 広報 社長

と表示させたいのです。複数あれば複数表示。

最終的にはその内容をシートにコピーしたいのですが、それはまた次の段階なので。
以上ですが、親身になって答えてくれているので、私の説明下手がはがゆい限りです。

【36072】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 14:26 -

引用なし
パスワード
   検索かけるターゲットのセル範囲ですが、1の列は関係なく2の列以下がデータです。

【36104】Re:ユーザーフォームにて検索結果をリス...
発言  kobasan  - 06/3/20(月) 21:20 -

引用なし
パスワード
   今晩は。

>検索かけるターゲットのセル範囲ですが、1の列は関係なく2の列以下がデータです。

ということは、CSVファイルを一旦Sheeet1上に読み込んでから、検索をかける仕様でも良いということでしょうか?

それから、ここで「列」と書いてあるけれど、たぶん「行」のことですね。

【36106】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/20(月) 22:34 -

引用なし
パスワード
   そのとおりです。
すみません。行と列を勘違いしてました。

CSVのままでできるものとCSVそのもに検索をかけるのは無理なんでしょうか?

【36109】Re:ユーザーフォームにて検索結果をリス...
発言  kobasan  - 06/3/21(火) 0:36 -

引用なし
パスワード
   こんばんは。

>CSVのままでできるものとCSVそのもに検索をかけるのは無理なんでしょうか?

CSVファイルを一旦Sheeet1上に読み込んでから、検索をかける仕様だと、プログラムしやすいし、わかりやすいです。

「CSVのままでできるものとCSVそのもに検索をかけるのは無理」ではないですが、CSVとBookの両方を開いて操作することになります。CSVを開いておかないとスピードが極端に悪くなり、操作しにくいと思います。

一旦Sheeet1上に読み込むと、Bookだけを扱えば良いことになります。

CSVのままででも、一旦Sheeet1上に読み込んでからでも、データの数によっては処理スピードがかかって、実用的でなくなるかもしれません。

ということで、スピードは別として、分りやすさと作りやすさで、一旦Sheeet1上に読み込んでから、検索をかける方法が一番お勧めです。

【36127】Re:ユーザーフォームにて検索結果をリス...
発言  エターナル  - 06/3/21(火) 19:54 -

引用なし
パスワード
   わかりやすいご説明ありがとうございます。
仕様を変更して一旦BOOKに落とすようにします。
その場合はどういったコードになるのでしょうか?

また、データをCSVにいちいち落とすより、後々検索かけるなら、初めからシートに落としたほうが、トータルで良いのですか?
自分はテキスト形式のほうが、読み書きが早いものだと思い込んでいました。

【36128】Re:ユーザーフォームにて検索結果をリス...
回答  kobasan  - 06/3/21(火) 20:14 -

引用なし
パスワード
   みなさん、今晩は。

>わかりやすいご説明ありがとうございます。
>仕様を変更して一旦BOOKに落とすようにします。
>その場合はどういったコードになるのでしょうか?

db.csvは本マクロを含むブックと同一フォルダにあるものとします。
これでできます。

'''''''''''''''''以下は標準モジュールに貼り付けて下さい
Sub test()
Dim w As Workbook
Dim flag As Boolean
  Sheets("Sheet1").Cells.Clear
  Read_CSV
  UserForm1.Show
End Sub

Sub Read_CSV()
  Dim dat As Variant
  Dim rw As Long
  Dim vntA() As Variant
  '
  Open ThisWorkbook.Path & "\db.csv" For Input As #1
  rw = 1
  Do Until EOF(1)
    Line Input #1, dat
    ReDim Preserve vntA(1 To rw)
    vntA(rw) = Split(dat, ",")
    rw = rw + 1
  Loop
  Close #1
  Sheets("Sheet1").Range("A1").Resize(UBound(vntA), UBound(vntA(1)) + 1).Value _
        = Application.Transpose(Application.Transpose(vntA))
  Erase vntA
End Sub

'''''''''''''''''以下はUserForm1モジュールに貼り付けて下さい
UserForm1にはTextBox1とListBox1とCommandButton1を作ります


Private Sub CommandButton1_Click()
Dim r As Range, FirstCell As Range, rng As Range
Dim vnt As Variant
Dim prow As Long
Dim s As Worksheet
Dim cnt As Long
  '
  Set s = Sheets("Sheet1")
  Set rng = Intersect(s.Range("A:G"), s.UsedRange)
  Set r = rng.Find(What:=TextBox1.Text)
  If r Is Nothing Then GoTo Exit_sub
  Set FirstCell = r
  ReDim vnt(0)
  vnt(0) = s.Cells(r.Row, 1).Resize(1, 7).Value
  prow = r.Row  '同じ行かチック
  cnt = 1
  Do
    Set r = s.UsedRange.FindNext(r)
    If Not r Is Nothing And (r.Address <> FirstCell.Address) _
        And (FirstCell.Row <> r.Row) And (prow <> r.Row) Then
      ReDim Preserve vnt(UBound(vnt) + 1)
      vnt(UBound(vnt)) = s.Cells(r.Row, 1).Resize(1, 7).Value
      prow = r.Row
      cnt = cnt + 1
    End If
  Loop While r.Address <> FirstCell.Address
  '
  If cnt = 1 Then vnt = s.Cells(FirstCell.Row, 1).Resize(1, 7).Value
  If cnt > 1 Then vnt = Application.Transpose(Application.Transpose(vnt))
  ListBox1.List = vnt
  '
  Set FirstCell = Nothing
  Erase vnt
Exit_sub:
  If cnt = 0 Then ListBox1.Clear
  Set r = Nothing
  Set rng = Nothing
  Set s = Nothing
End Sub

Private Sub UserForm_Initialize()
  ListBox1.ColumnCount = 7  'ListBox1の列は7列にする
  Me.TextBox1.SetFocus
End Sub


>また、データをCSVにいちいち落とすより、後々検索かけるなら、初めからシートに落としたほうが、トータルで良いのですか?

Excelで操作するなら、その方がいいと思います。

>自分はテキスト形式のほうが、読み書きが早いものだと思い込んでいました。

CSVは他のソフトとやりとりするときによく利用します。

【36132】Re:ユーザーフォームにて検索結果をリス...
発言  kobasan  - 06/3/21(火) 21:31 -

引用なし
パスワード
   訂正があります

>  cnt = 1
>  Do
>    Set r = s.UsedRange.FindNext(r)

のところの
    Set r = s.UsedRange.FindNext(r)

    Set r = rng.FindNext(r)

に訂正してください。

【36148】Re:ユーザーフォームにて検索結果をリス...
お礼  エターナル  - 06/3/22(水) 17:44 -

引用なし
パスワード
   見事解決いたしました。
この度はありがとうございました。

7909 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free