advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 671 for 』( ! ---- | ----* (0.114 sec.)
』( (96027), ---- (-96148)
[[20190212201647]]
#score: 4666
@digest: 586f26a76fcec1ede837d3e6c8f81915
@id: 78612
@mdate: 2019-02-12T11:26:39Z
@size: 6944
@type: text/plain
#keywords: mydata2 (73018), listno3 (29523), listno5 (29523), listno4 (29523), mydata (28346), listno2 (27628), listno1 (25703), key10 (13718), myrow4 (13625), key9 (13180), key8 (13180), key7 (13013), 索フ (12829), key6 (12255), listno (12197), key5 (10139), combobox7 (9298), combobox8 (9298), key4 (8558), mydata3 (6859), myfld (5910), listindex (5453), combobox4 (5165), listbox1 (5065), mycri (5005), key3 (3991), textbox5 (3860), combobox3 (3770), columnwidths (3526), lastrow (3061), textbox6 (2940), listbox (2888)
『検索フォームの動作について』(楓)
入力フォームと検索フォームを作成し、データ処理を行おうと思っています。 問題は、検索フォームの方なのですが、フォームには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 > ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/201902/20190212201647.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97065 documents and 608342 words.

訪問者:カウンタValid HTML 4.01 Transitional