Excel VBA質問箱 IV

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

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


45594 / 76732 ←次へ | 前へ→

【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は他のソフトとやりとりするときによく利用します。

28 hits

【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 お礼

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