[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索結果をリストボックスに表示』（あや）
ユーザーフォームで完全一致の検索結果をリストボックスに表示させたいのですが、以下のコードを実行してもリストボックスには何も表示されません。
どうか助けてくださいm(_ _)m
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub commandbutton1_Click()
Dim lastrow As Long
Dim myData, myData2(), myNo
Dim i As Long, j As Long, cn As Long
If TextBox1.Value = "" Or TextBox2.Value = "" Then End
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(2, 1), .Cells(lastrow, 50)).Value
End With
ReDim myData2(1 To lastrow, 1 To 50)
For i = LBound(myData) To UBound(myData)
If myData(i, 21) = textbox1.Value And myData(i, 22) = textbox2.Value Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 20)
myData2(cn, 3) = myData(i, 21)
myData2(cn, 4) = myData(i, 22)
myData2(cn, 5) = myData(i, 23)
myData2(cn, 6) = myData(i, 4)
myData2(cn, 7) = myData(i, 49)
myData2(cn, 8) = myData(i, 50)
myData2(cn, 9) = myData(i, 13)
myData2(cn, 10) = myData(i, 14)
myData2(cn, 11) = myData(i, 15)
myData2(cn, 12) = myData(i, 16)
myData2(cn, 13) = myData(i, 17)
End If
Next i
With listbox1
.ColumnCount = 13
.ColumnWidths = "50;40;20;20;20;150;150;100;50;30;20;30;80"
.List = myData2
End With
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
動かしていないですけど、
このステートメントは正しいですか？(すぐ終わっちゃうような気がするんですけど）
↓
＞ If TextBox1.Value = "" Or TextBox2.Value = "" Then End
（半平太） 2018/12/04(火) 11:26
よくやる手ですが、List/Combo Box には Listの他に Column Propertyがあります。 myData2の行列を逆にしてColumn Propertyにセットしてやる方がすんなり行く気がします。
Private Sub commandbutton1_Click()
Dim lastrow As Long
Dim myData, myData2(), myNo
Dim i As Long, ii As Long, cn As Long, myCols
If TextBox1.Value = "" Or TextBox2.Value = "" Then End
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(2, 1), .Cells(lastrow, 50)).Value
End With
myCols = Array(1, 20, 21, 22, 23, 4, 49, 50, 13, 14, 15, 16, 17)
ReDim myData2(1 To UBound(myCols) + 1, 1 To lastrow)
For i = LBound(myData) To UBound(myData)
If myData(i, 21) = TextBox1.Value And myData(i, 22) = TextBox2.Value Then
cn = cn + 1
For ii = 0 To UBound(myCols)
myData2(ii + 1, cn) = myData(i, myCols(ii))
Next
End If
Next i
With ListBox1
.Clear
If cn = 0 Then Exit Sub
ReDim Preserve myData2(1 To UBound(myCols) + 1, 1 To cn) '<--追加
.ColumnCount = 13
.ColumnWidths = "50;40;20;20;20;150;150;100;50;30;20;30;80"
.Column = myData2
End With
End Sub
（seiya） 2018/12/04(火) 11:48
一行追加
21列目か22列目には数字が入っていませんか？ 例えばTextBox2に「10」と入っていたとして
TextBox2.Value は "10" になります。 もしシート上にあるのが数値なら Val(TextBox2) とすればちゃんと拾えます。
見当違いだったらすみません。
あと、21列目と22列目にTextBox1とTextBox2の値でフィルタをかけてから 配列に入れるのも手だと思いますよ。
（TAKA） 2018/12/04(火) 12:05
Private Sub commandbutton1_Click()
Dim lastrow As Long
Dim myData, myData2(), myNo
Dim i As Long, j As Long, cn As Long
If TextBox1.Value = "" Or TextBox2.Value = "" Then End
With Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(2, 1), .Cells(lastrow, 50)).Value
End With
ReDim myData2(1 To lastrow, 1 To 50)
For i = LBound(myData) To UBound(myData)
If myData(i, 21) = TextBox1.Value And myData(i, 22) = Val(TextBox2) Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 20)
myData2(cn, 3) = myData(i, 21)
myData2(cn, 4) = myData(i, 22)
myData2(cn, 5) = myData(i, 23)
myData2(cn, 6) = myData(i, 4)
myData2(cn, 7) = myData(i, 49)
myData2(cn, 8) = myData(i, 50)
myData2(cn, 9) = myData(i, 13)
myData2(cn, 10) = myData(i, 14)
myData2(cn, 11) = myData(i, 15)
myData2(cn, 12) = myData(i, 16)
myData2(cn, 13) = myData(i, 17)
End If
Next i
With ListBox1
.ColumnCount = 13
.ColumnWidths = "50;40;20;20;20;150;150;100;50;30;20;30;80"
.List = myData2
End With
End Sub
正常に表示されます
（TAKA） 2018/12/04(火) 12:06
数値・文字列関係なくで
1) 元コード編集案
Private Sub commandbutton1_Click()
Dim lastrow As Long
Dim myData, myData2(), myNo
Dim i As Long, ii As Long, cn As Long, myCols
If TextBox1.Value = "" Or TextBox2.Value = "" Then End
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(2, 1), .Cells(lastrow, 50)).Value
End With
myCols = Array(1, 20, 21, 22, 23, 4, 49, 50, 13, 14, 15, 16, 17)
ReDim myData2(1 To UBound(myCols) + 1, 1 To lastrow)
For i = LBound(myData) To UBound(myData)
If CStr(myData(i, 21)) = TextBox1.Value And CStr(myData(i, 22)) = TextBox2.Value Then
cn = cn + 1
For ii = 0 To UBound(myCols)
myData2(ii + 1, cn) = myData(i, myCols(ii))
Next
End If
Next i
With ListBox1
.Clear
If cn = 0 Then Exit Sub
ReDim Preserve myData2(1 To UBound(myCols) + 1, 1 To cn) '<--追加
.ColumnCount = 13
.ColumnWidths = "50;40;20;20;20;150;150;100;50;30;20;30;80"
.Column = myData2
End With
End Sub
2) 全くの別案
Private Sub commandbutton1_Click()
Dim a, x, y, myCols
If TextBox1.Value = "" Or TextBox2.Value = "" Then Exit Sub
x = Me.TextBox1.Value: y = Me.TextBox2.Value
If Not IsNumeric(x) Then x = Chr(34) & x & Chr(34)
If Not IsNumeric(y) Then y = Chr(34) & y & Chr(34)
With Worksheets("Sheet1").Cells(1).CurrentRegion
x = Filter(.Parent.Evaluate("transpose(if((" & .Columns(21).Address & "=" & x & ")*(" & _
.Columns(22).Address & "=" & y & "),row(1:" & .Rows.Count & ")))"), False, 0)
If UBound(x) = -1 Then Exit Sub
myCols = Array(1, 20, 21, 22, 23, 4, 49, 50, 13, 14, 15, 16, 17)
a = Application.Index(.Value, Application.Transpose(x), myCols)
End With
With ListBox1
.ColumnCount = 13
.ColumnWidths = "50;40;20;20;20;150;150;100;50;30;20;30;80"
If UBound(x) = 0 Then
.Column = a
Else
.List = a
End If
End With
End Sub
（seiya） 2018/12/04(火) 12:31
seiyaさんのように、セルの値の方を文字列に変換してもokですね。 （TAKA） 2018/12/04(火) 13:19
＞seiyaさん
＞TAKAさん
textbox1,textbox2とも主に数値が入るのですが、
seiyaさんの元コード編集案で想定通りに表示されました。
ありがとうございました。
本当に助かりました。
（あや） 2018/12/04(火) 16:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.