| |
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
