[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『検索フォームの動作について』（楓）
入力フォームと検索フォームを作成し、データ処理を行おうと思っています。
問題は、検索フォームの方なのですが、フォームにはComboBox、TextBox等を配置し
入力が終わった後、CommandButtonをクリックすると、ListBoxに結果が表示され、
別のCommandButtonをクリックすると"Sheet3"にその結果が転記されるようにしたいのですが、
以下の問題が発生し、解決できずにいます。
?@検索フォームのListBoxには各入力Boxの結果が反映されているのだが、"Sheet3"にそのまま反映されない。
※AutoFilter Fieldを2列目に指定しているため、Range("B3:T3")計19項目（うち検索フォームは10項目）の検索ができていない。
?AListBoxに表示されているListをダブルクリックしてもデバックが発生し該当行が変化しない。
?B"Sheet3"に反映させるには、一度ListBoxのListを選択し、CommandButtonを押さないといけない。
ネットで色々と調べてはいるのですが、思っているような答えが見つからずにいます。
どなたかお詳しい方がいらっしゃればご教示お願い致します。
Option Explicit
'----------------------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim LastRow As Long
Dim myData, myData2(), myno
Dim i As Long, j As Long, cn As Long
Dim key1 As String, key2 As String, key3 As String, key4 As String, key5 As String, key6 As String, _
key7 As String, key8 As String, key9 As String, key10 As String
Dim ListNo As Long
ListNo = ComboBox1.ListIndex
If ListNo < 0 Then
key1 = "*"
Else
key1 = ComboBox1.List(ListNo)
End If
Dim ListNo1 As Long
ListNo1 = ComboBox3.ListIndex
If ListNo1 < 0 Then
key2 = "*"
Else
key2 = ComboBox3.List(ListNo1)
End If
If TextBox1.Value = "" Then key3 = "*" Else key3 = "*" & TextBox1.Value & "*"
Dim ListNo2 As Long
ListNo2 = ComboBox4.ListIndex
If ListNo2 < 0 Then
key4 = "*"
Else
key4 = ComboBox4.List(ListNo2)
End If
Dim ListNo3 As Long
ListNo3 = ComboBox2.ListIndex
If ListNo3 < 0 Then
key5 = "*"
Else
key5 = ComboBox2.List(ListNo3)
End If
Dim ListNo4 As Long
ListNo4 = ComboBox7.ListIndex
If ListNo4 < 0 Then
key6 = "*"
Else
key6 = ComboBox7.List(ListNo4)
End If
Dim ListNo5 As Long
ListNo5 = ComboBox8.ListIndex
If ListNo5 < 0 Then
key7 = "*"
Else
key7 = ComboBox8.List(ListNo5)
End If
If TextBox2.Value = "" Then key8 = "*" Else key8 = "*" & TextBox2.Value & "*"
If TextBox3.Value = "" Then key9 = "*" Else key9 = "*" & TextBox3.Value & "*"
If TextBox5.Value = "" Then key10 = "*" Else key10 = "*" & TextBox5.Value & "*"
With Worksheets("2019.4")
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
myData = .Range(.Cells(3, 1), .Cells(LastRow, 20)).Value
End With
ReDim myData2(1 To LastRow, 1 To 10)
For i = LBound(myData) To UBound(myData)
If myData(i, 2) Like key1 And myData(i, 3) Like key2 And myData(i, 5) Like key3 And myData(i, 9) Like key4 _
And myData(i, 20) Like key5 And myData(i, 16) Like key6 And myData(i, 17) Like key7 And myData(i, 10) Like key8 _
And myData(i, 11) Like key9 And myData(i, 8) Like key10 Then
cn = cn + 1
myData2(cn, 1) = myData(i, 2) myData2(cn, 2) = myData(i, 3) myData2(cn, 3) = myData(i, 5) myData2(cn, 4) = myData(i, 9) myData2(cn, 5) = myData(i, 20) myData2(cn, 6) = myData(i, 16) myData2(cn, 7) = myData(i, 17) myData2(cn, 8) = myData(i, 10) myData2(cn, 9) = myData(i, 11) myData2(cn, 10) = myData(i, 8) End If Next i
With ListBox1 .ColumnCount = 10 .ColumnWidths = "45;40;65;20;20;60;60;60;60;20" .List = myData2 End With
TextBox7.Value = Worksheets("2019.4").Cells(Rows.Count, 2).End(xlUp).Row - 2
End Sub
'------------------------------------------------------------------------------------------------
Private Sub CommandButton2_Click()
ComboBox1 = "" ComboBox2 = "" ComboBox3 = "" ComboBox4 = "" ComboBox5 = "" ComboBox6 = "" ComboBox7 = "" ComboBox8 = "" TextBox1 = "" TextBox2 = "" TextBox3 = "" TextBox5 = "" TextBox6 = "" ListBox1.Clear
Worksheets("2019.4").Activate
End Sub
'---------------------------------------------------------------------------------------------------
Private Sub CommandButton3_Click()
Dim myFld, myCri
Dim myRow4 As String
Dim Sh2 As Worksheet, Sh3 As Worksheet
Set Sh2 = Worksheets("2019.4")
Set Sh3 = Worksheets("Sheet3")
myFld = 2
myCri = UserForm2.ListBox1.Value
With Sh2
.Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
myRow4 = .Range("A" & Rows.Count).End(xlUp).Row
Sh3.Range("A:T").ClearContents
.Range("A1:T" & myRow4).Copy Sh3.Range("A1")
TextBox6.Value = Worksheets("sheet3").Cells(Rows.Count, 2).End(xlUp).Row - 2
.Range("A1").AutoFilter
End With
Sh3.Activate
Range("A1").Select
End Sub
'-----------------------------------------------------------------------------------
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With Worksheets("2019.4")
.Range(.Cells(ListBox1.List(ListBox1.ListIndex, 0) + 2, 2), .Cells(ListBox1.List(ListBox1.ListIndex, 0) + 2, 20)).Select End With
End Sub
'---------------------------------------------------------------------------------
Private Sub userform2_initialize()
Dim LastRow As Long Dim myData, mayData2(), myno Dim i As Long, j As Long, cn As Long
With Worksheets("2019.4")
LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
myData = .Range(.Cells(3, 1), .Cells(LastRow, 20)).Value
End With
ReDim myData2(1 To LastRow, 1 To 10)
For i = LBound(myData) To UBound(myData)
myData2(i, 1) = myData(i, 2)
myData2(i, 2) = myData(i, 3)
myData2(i, 3) = myData(i, 5)
myData2(i, 4) = myData(i, 9)
myData2(i, 5) = myData(i, 20)
myData2(i, 6) = myData(i, 16)
myData2(i, 7) = myData(i, 17)
myData2(i, 8) = myData(i, 10)
myData2(i, 9) = myData(i, 11)
myData2(i, 10) = myData(i, 8)
Next i
With ListBox1
.ColumnCount = 10
.ColumnWidths = "45;40;65;20;20;60;60;60;60;20"
.List = myData2
End With
Dim lastRow2 As Long Dim myData3
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.