| |
こんにちは。かみちゃん です。
>>検索終了しComboBox1の▼をクリックリスト内から選択したときに
>>A列のデータしか今はComboBoxに載りませんが、
>>一応３列目まで表示させるには
>>どの数字をさわればいいでしょうか？
>>なお、転記はA列のみでOKなのですが
1.選択肢としては、ColumnCountで指定した列数（A列〜C列）を表示
2.選択したら、ComboBoxには、TextColumnで指定した列（1列のみ）の値を表示
3.ComboBoxの値としては、TextColumnで指定した列とは別にBoundColumnで指定した列（1列のみ）の値とする。
ということになっています。
そこで、yasuさんの「一応３列目まで表示させる」という要件を実現するた
めには、以下のように修正する必要があります。
実現できるのは、UserForm4のコードのみです。
UserForm3やUserForm2では、難しいです。
★の部分を修正する必要がありますので、そこまでして、「一応の要件」を
満たす必要があるのかよく考えてください。
考え方としては、A列〜C列の値をComboBoxに表示する場合に、さらに１列を
ComboBoxに追加して、それを表示用の列とします。
以下のコードでは、左から1列目が表示用の列として、残り３列を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
>こんなのもあり色々試したのですがダメでした
>
> コンボボックスのリストには、複数の列を表示することが可能です。
見当違いです。それは、選択肢の複数列表示ですから、すでに対応してあります。
そこまでして、「一応の要件」を満たしたいのは、なぜなのでしょうか？
一歩一歩積み上げていかないと、わけわからなくなると思うのですが・・・
「一応」「とりあえず」「念のため」は手戻りの原因です。
それを覚悟の上でしたらいいのですが、心配です。
|
|
かみちゃん
- 07/1/24(水) 20:51 -
