Excel VBA質問箱 IV

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

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


213 / 74991 ←次へ | 前へ→

【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

70 hits

【80422】検索フォームの動作について tarutaru 19/2/13(水) 13:36 質問[未読]
【80425】Re:検索フォームの動作について マナ 19/2/13(水) 19:15 発言[未読]
【80426】Re:検索フォームの動作について tarutaru 19/2/13(水) 22:09 質問[未読]
【80427】Re:検索フォームの動作について tarutaru 19/2/14(木) 3:30 質問[未読]
【80432】Re:検索フォームの動作について マナ 19/2/14(木) 19:22 発言[未読]
【80434】Re:検索フォームの動作について tarutaru 19/2/15(金) 14:18 回答[未読]
【80439】Re:検索フォームの動作について マナ 19/2/16(土) 9:24 発言[未読]
【80448】Re:検索フォームの動作について tarutaru 19/2/16(土) 17:20 回答[未読]
【80449】Re:検索フォームの動作について マナ 19/2/16(土) 19:35 発言[未読]
【80456】Re:検索フォームの動作について tarutaru 19/2/16(土) 21:38 発言[未読]
【80463】Re:検索フォームの動作について マナ 19/2/16(土) 23:22 発言[未読]
【80464】Re:検索フォームの動作について マナ 19/2/17(日) 0:03 発言[未読]
【80466】Re:検索フォームの動作について tarutaru 19/2/17(日) 7:42 発言[未読]
【80470】Re:検索フォームの動作について マナ 19/2/17(日) 10:31 発言[未読]
【80473】Re:検索フォームの動作について マナ 19/2/17(日) 11:19 発言[未読]
【80475】Re:検索フォームの動作について tarutaru 19/2/17(日) 17:33 お礼[未読]
【80477】Re:検索フォームの動作について マナ 19/2/17(日) 18:55 発言[未読]
【80480】Re:検索フォームの動作について tarutaru 19/2/17(日) 20:50 お礼[未読]
【80495】Re:検索フォームの動作について tarutaru 19/2/19(火) 22:54 お礼[未読]
【80496】Re:検索フォームの動作について マナ 19/2/20(水) 19:29 発言[未読]
【80497】Re:検索フォームの動作について tarutaru 19/2/21(木) 12:09 お礼[未読]

213 / 74991 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free