Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1956 / 76734

←次へ　｜　前へ→


	【80422】検索フォームの動作について

tarutaru - 19/2/13(水) 13:36 -


	引用なし

	パスワード

VBA初心者です。
入力フォームと検索フォームを作成し、データ処理を行おうと思っています。
問題は、検索フォームの方なのですが、フォームにはComboBox、TextBox等を配置し
入力が終わった後、CommandButtonをクリックすると、ListBoxに結果が表示され、
別のCommandButtonをクリックすると"Sheet3"にその結果が転記されるようにしたいのですが、以下の問題が発生し、解決できず困っています。

1.検索フォームのListBoxには各入力Boxの結果が反映されているのだが、"Sheet3"にそのまま反映されない。 ※AutoFilter Fieldを2列目に指定しているため、Range("B3:T3")計19項目（うち検索フォームは10項目）の検索ができていない。

2.AListBoxに表示されているListをダブルクリックしてもデバックが発生し該当行が変化しない。

3."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

8 hits

▼

【80422】検索フォームの動作について tarutaru 19/2/13(水) 13:36