Excel VBA質問箱 IV

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

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


35768 / 76732 ←次へ | 前へ→

【46159】Re:ユーザーフォームのリストを検索→転記
発言  かみちゃん E-MAIL  - 07/1/24(水) 20:51 -

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

>>検索終了しComboBox1の▼をクリックリスト内から選択したときに
>>A列のデータしか今はComboBoxに載りませんが、
>>一応3列目まで表示させるには
>>どの数字をさわればいいでしょうか?
>>なお、転記はA列のみでOKなのですが

1.選択肢としては、ColumnCountで指定した列数(A列〜C列)を表示
2.選択したら、ComboBoxには、TextColumnで指定した列(1列のみ)の値を表示
3.ComboBoxの値としては、TextColumnで指定した列とは別にBoundColumnで指定した列(1列のみ)の値とする。
ということになっています。

そこで、yasuさんの「一応3列目まで表示させる」という要件を実現するた
めには、以下のように修正する必要があります。
実現できるのは、UserForm4のコードのみです。
UserForm3やUserForm2では、難しいです。
★の部分を修正する必要がありますので、そこまでして、「一応の要件」を
満たす必要があるのかよく考えてください。

考え方としては、A列〜C列の値をComboBoxに表示する場合に、さらに1列を
ComboBoxに追加して、それを表示用の列とします。
以下のコードでは、左から1列目が表示用の列として、残り3列をA列〜C列
の値を割り当てるようにしています。

'==================================================
'■UserForm4モジュール
'==================================================

'コード.xlsのA1セル〜A列の値の入っている最終行のC列までをComboBoxへ追加
' 検索条件部分一致を選択肢とする
' 部分一致は全角半角、大文字小文字を無視
Private Sub CommandButton1_Click()
 Dim WB1 As Workbook
 Dim WB2 As Workbook
 Dim strFileName As String
 Dim ws As Worksheet
 Dim lngRow As Long
 Dim rng As Range
 Dim ComboBox_Row As Long

 Set WB1 = ThisWorkbook
 strFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls")
 If strFileName <> "False" Then
  Application.ScreenUpdating = False
  'すでに開いているかどうかをチェックする
  If Not ChkWorkbook(Mid(strFileName, InStrRev(strFileName, "\") + 1)) Then
   MsgBox strFileName & vbCrLf & "を開きます"
   Set WB2 = Workbooks.Open(strFileName)
  Else
   Set WB2 = Workbooks(Mid(strFileName, InStrRev(strFileName, "\") + 1))
  End If
  WB1.Activate
 
  Set ws = WB2.Sheets("Sheet1")
  Set rng = ws.Range("A1", ws.Cells(Rows.Count, 1).End(xlUp)).Resize(, 3)
  ComboBox_Row = 0
  With Me.ComboBox1
   .ColumnCount = rng.Columns.Count + 1 '★
   .ColumnWidths = "40 pt;0 pt;0 pt;0 pt" '★
   .TextColumn = 1 '★
   .BoundColumn = 1 '★
   For lngRow = 1 To rng.Rows.Count
    If StrConv(StrConv(rng.Cells(lngRow, 2).Value, vbWide), vbUpperCase) _
     Like "*" & StrConv(StrConv(Me.TextBox1.Value, vbWide), vbUpperCase) & "*" Then
'     .AddItem rng.Cells(lngRow, 1).Value
'     .List(ComboBox_Row, 1) = rng.Cells(lngRow, 2).Value
'     .List(ComboBox_Row, 2) = rng.Cells(lngRow, 3).Value
     .AddItem rng.Cells(lngRow, 1).Value & " " & _
          rng.Cells(lngRow, 2).Value & " " & _
          rng.Cells(lngRow, 3).Value '★
     .List(ComboBox_Row, 1) = rng.Cells(lngRow, 1).Value '★
     .List(ComboBox_Row, 2) = rng.Cells(lngRow, 2).Value '★
     .List(ComboBox_Row, 3) = rng.Cells(lngRow, 3).Value '★
     ComboBox_Row = ComboBox_Row + 1
    End If
   Next
'   .ColumnWidths = "20 pt;20 pt;20 pt"
'   .BoundColumn = 1
  End With
  Application.ScreenUpdating = True
 Else
  MsgBox "コード.xlsのファイル選択を中止しました"
 End If
End Sub


Findメソッドを使う場合

  ComboBox_Row = 0
  With Me.ComboBox1
   .ColumnCount = rng.Columns.Count + 1 '★
   .ColumnWidths = "40 pt;0 pt;0 pt;0 pt" '★
   .TextColumn = 1 '★
   .BoundColumn = 1 '★
   
   '---検索条件部分一致検索(全角・半角区別なし、大文字・小文字区別なし)

   Dim c As Range
   Dim FirstAddress As String

   Set c = rng.Columns(2).Find(Me.TextBox1.Value, , xlValues, xlPart, , , False, False)
   If Not c Is Nothing Then
    FirstAddress = c.Address
    Do
     .AddItem c.Offset(, -1).Value & " " & _
          c.Value & " " & _
          c.Offset(, 1).Value '★
     .List(ComboBox_Row, 1) = c.Offset(, -1).Value '★
     .List(ComboBox_Row, 2) = c.Value '★
     .List(ComboBox_Row, 3) = c.Offset(, 1).Value '★
'     .AddItem c.Offset(, -1).Value
'     .List(ComboBox_Row, 1) = c.Value
'     .List(ComboBox_Row, 2) = c.Offset(, 1).Value
     ComboBox_Row = ComboBox_Row + 1
     Set c = rng.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> FirstAddress
   End If
   '---検索条件部分一致検索 ここまで
   
'   .ColumnWidths = "20 pt;20 pt;20 pt"
'   .BoundColumn = 1
  End With

>こんなのもあり色々試したのですがダメでした
>
> コンボボックスのリストには、複数の列を表示することが可能です。

見当違いです。それは、選択肢の複数列表示ですから、すでに対応してあります。
そこまでして、「一応の要件」を満たしたいのは、なぜなのでしょうか?
一歩一歩積み上げていかないと、わけわからなくなると思うのですが・・・
「一応」「とりあえず」「念のため」は手戻りの原因です。
それを覚悟の上でしたらいいのですが、心配です。
10 hits

【46028】ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:02 質問
【46030】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 17:15 発言
【46031】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 17:33 発言
【46037】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 18:43 発言
【46039】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 20:29 発言
【46043】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 20:46 発言
【46051】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 22:51 発言
【46052】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/21(日) 23:12 発言
【46057】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/21(日) 23:32 発言
【46058】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 0:09 発言
【46060】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 0:21 発言
【46061】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 7:15 発言
【46063】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 10:21 発言
【46064】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 11:35 発言
【46067】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:18 発言
【46070】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 13:01 発言
【46071】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 13:09 発言
【46066】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 12:04 発言
【46084】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 17:25 発言
【46085】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:06 発言
【46087】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:12 発言
【46088】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:23 発言
【46086】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 18:07 発言
【46090】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 18:45 発言
【46092】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 20:48 発言
【46098】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 21:48 発言
【46099】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:07 発言
【46100】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/22(月) 22:44 発言
【46101】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/22(月) 22:55 発言
【46106】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 2:51 発言
【46107】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 3:03 発言
【46109】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 7:33 発言
【46114】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 9:28 発言
【46117】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 11:09 回答
【46120】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 14:09 発言
【46121】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 14:42 発言
【46122】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 15:09 発言
【46124】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 16:51 回答
【46129】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 17:33 発言
【46133】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/23(火) 20:22 発言
【46134】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/23(火) 20:40 発言
【46139】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 3:58 発言
【46140】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 7:28 発言
【46157】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/24(水) 20:44 発言
【46159】Re:ユーザーフォームのリストを検索→転記 かみちゃん 07/1/24(水) 20:51 発言
【46168】Re:ユーザーフォームのリストを検索→転記 yasu 07/1/25(木) 0:22 お礼

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