[[20080702141725]]　『ListBoxの日付検索方法について教えて下さい。』（VBA勉強中）　ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

　

『ListBoxの日付検索方法について教えて下さい。』（VBA勉強中） 
 CommandButton37を押すことによってﾜｰｸｼｰﾄ(DATA)から(WAREA)へコピーして
ListBox1に表示させています。
表示項目は左から
”番号””日付””担当者””名前１””名前2””名前3””方式””ｶﾃｺﾞﾘｰ””時間１””時間２”
と表示させています。
ここで”日付”ですが、2008/06/01～2008/06/30までランダム(番号順のため)に表示させています。
そこで、TextBox1に日付(2008/06/10)と入力してCommandButton2を押すと2008/06/10のみのデータを
表示させるにはどうしたらよいでしょうか？
　
ListBox1に表示させる構文は次の通りです。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub CommandButton37_Click()
　
Worksheets("DATA").Range("A1").CurrentRegion.Copy Worksheets("WAREA").Range("A1")
　
With ListBox1
.ColumnHeads = True
.ColumnCount = 10
.ColumnWidths = "30;80;55;60;60;60;65;45;45;"
'.Text = "DATA!A2:J100"
.RowSource = "WAREA!A2:J100"
　
End With
　
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
まったくの素人なので大先輩方、よろしくお願いいたします。

 Private Sub CommandButton2_Click()
     Dim myRow As Long
     With Application.WorksheetFunction
         If .CountIf(Worksheets("WAREA").Range("A2:J100"), Me.TextBox1.Text) > 0 Then
             myRow = .Match(CLng(DateValue(Me.TextBox1.Text)), Worksheets("WAREA").Range("B1:B100"), 0)
             Worksheets("WAREA").Range("A1:j1").Copy Destination:=Worksheets("WAREA").Range("A101")
             Worksheets("WAREA").Range("A" & myRow & ":j" & myRow).Copy Destination:=Worksheets("WAREA").Range("A102")
             Me.ListBox1.RowSource = "WAREA!A102:J102"
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With
 End Sub
　
一例。
ColumnHeads を生かすため、別の場所にRowSource用のデータを
作成する例。WAREA!A101:J102に見出しと対象データのみ書き出し、
それをRowSourceにしてます。
　
他にも方法はあると思われます。
(みやほりん)(-_∂)b


 ご指導、ありがとうございます。
早速に修正しましたが、うまく動かないので再度、質問がてらご指導お願いいたします。
TextBox48⇒日付(2008/06/10)を入力
Private Sub CommandButton44⇒検索コマンド
"WAREA"のC列に日付データがあります。
このC列には下の様な日付データが格納してあります。
2008/6/6
2008/6/8
2008/6/8
2008/6/10
2008/6/10
2008/6/11
2008/6/11
2008/6/12
2008/6/12
2008/6/15
2008/6/15
2008/6/16
2008/6/16
2008/6/16
2008/6/26
2008/7/1
2008/7/1
ここでTextBox48に2008/06/16と入力してPrivate Sub CommandButton44で検索をかけると
2008/06/15のデータ１つのみの表示になってしまいます。
TextBox48に2008/06/16と入力したときに6/16の3つのデータを表示するにはどうすればよいでしょうか
長々と申し訳ありませんが、ご指導お願いいたします。

構文は以下の通りです。

Private Sub CommandButton44_Click() 

  Dim myRow As Long


     With Application.WorksheetFunction
         If .CountIf(Worksheets("WAREA").Range("A2:J100"), Me.TextBox48.Text) > 0 Then
             myRow = .Match(CLng(DateValue(Me.TextBox48.Text)), Worksheets("WAREA").Range("C2:C100"), 0)
             Worksheets("WAREA").Range("A1:J1").Copy Destination:=Worksheets("WAREA").Range("A101")
             Worksheets("WAREA").Range("A" & myRow & ":J" & myRow).Copy Destination:=Worksheets("WAREA").Range("A102")
             Me.ListBox1.RowSource = "WAREA!A102:J102"
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With

End Sub

Private Sub CommandButton2_Click() 
     Dim myRow As Long
     With Application.WorksheetFunction
         If .CountIf(Worksheets("WAREA").Range("A2:J100"), Me.TextBox1.Text) > 0 Then
             myRow = .Match(CLng(DateValue(Me.TextBox1.Text)), Worksheets("WAREA").Range("B1:B100"), 0)
             Worksheets("WAREA").Range("A1:j1").Copy Destination:=Worksheets("WAREA").Range("A101")
             Worksheets("WAREA").Range("A" & myRow & ":j" & myRow).Copy Destination:=Worksheets("WAREA").Range("A102")
             Me.ListBox1.RowSource = "WAREA!A102:J102"
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With
 End Sub
　
一例。
ColumnHeads を生かすため、別の場所にRowSource用のデータを
作成する例。WAREA!A101:J102に見出しと対象データのみ書き出し、
それをRowSourceにしてます。
　
他にも方法はあると思われます。
(みやほりん)(-_∂)b


 ご指導、ありがとうございます。
早速に修正しましたが、うまく動かないので再度、質問がてらご指導お願いいたします。
TextBox48⇒日付(2008/06/10)を入力
Private Sub CommandButton44⇒検索コマンド
"WAREA"のC列に日付データがあります。
このC列には下の様な日付データが格納してあります。
2008/6/6
2008/6/8
2008/6/8
2008/6/10
2008/6/10
2008/6/11
2008/6/11
2008/6/12
2008/6/12
2008/6/15
2008/6/15
2008/6/16
2008/6/16
2008/6/16
2008/6/26
2008/7/1
2008/7/1
ここでTextBox48に2008/06/16と入力してPrivate Sub CommandButton44で検索をかけると
2008/06/15のデータ１つのみの表示になってしまいます。
TextBox48に2008/06/16と入力したときに6/16の3つのデータを表示するにはどうすればよいでしょうか
長々と申し訳ありませんが、ご指導お願いいたします。
構文は以下の通りです。

Private Sub CommandButton44_Click() 

  Dim myRow As Long


     With Application.WorksheetFunction
         If .CountIf(Worksheets("WAREA").Range("A2:J100"), Me.TextBox48.Text) > 0 Then
             myRow = .Match(CLng(DateValue(Me.TextBox48.Text)), Worksheets("WAREA").Range("C2:C100"), 0)
             Worksheets("WAREA").Range("A1:J1").Copy Destination:=Worksheets("WAREA").Range("A101")
             Worksheets("WAREA").Range("A" & myRow & ":J" & myRow).Copy Destination:=Worksheets("WAREA").Range("A102")
             Me.ListBox1.RowSource = "WAREA!A102:J102"
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With
End Sub 


 ＞Worksheets("WAREA").Range("C2:C100")
なぜ　C2　から？
MATCH関数で求められるのが何か、Helpで確認してください。
（ExcelVBAのヘルプではありません。Excelのヘルプです。）
それはさておき。
　
ランダム＝複数存在の可能性は思いつきませんでした。
　
それとビミョーにこちらのイメージと違いますねぇ。
ボタン押下時点でWAREAのデータをどうにかしちゃっても良いのなら、下記。
　
 Private Sub CommandButton2_Click()
'     Dim myRow As Long
     With Application.WorksheetFunction
         If .CountIf(Worksheets("DATA").Range("C2:C100"), Me.TextBox1.Text) > 0 Then
             Worksheets("WAREA").Cells.ClearContents
             Worksheets("DATA").Range("A1").AutoFilter _
                 Field:=3, _
                 Criteria1:=">=" & Me.TextBox1.Text, _
                 Operator:=xlAnd, _
                 Criteria2:="<=" & Me.TextBox1.Text
             Worksheets("DATA").Range("A1").CurrentRegion.Copy Destination:=Worksheets("WAREA").Range("A1")
'             myRow = Worksheets("WAREA").Range("A1").CurrentRegion.Rows.Count
'             Me.ListBox1.RowSource = "TEMP!A2:J" & myRow
             Worksheets("DATA").Range("A1").AutoFilter
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With
 End Sub
　
WAREAシートはそのままにしておく必要があり、TEMPというシートを一つ追加してよいなら、下記。
　
 Private Sub CommandButton2_Click()
     Dim myRow As Long
     With Application.WorksheetFunction
         If .CountIf(Worksheets("WAREA").Range("C2:C100"), Me.TextBox1.Text) > 0 Then
             Worksheets("TEMP").Cells.ClearContents
             Worksheets("WAREA").Range("A1").AutoFilter _
                 Field:=3, _
                 Criteria1:=">=" & Me.TextBox1.Text, _
                 Operator:=xlAnd, _
                 Criteria2:="<=" & Me.TextBox1.Text
             Worksheets("WAREA").Range("A1").CurrentRegion.Copy Destination:=Worksheets("TEMP").Range("A1")
             myRow = Worksheets("TEMP").Range("A1").CurrentRegion.Rows.Count
             Me.ListBox1.RowSource = "TEMP!A2:J" & myRow
             Worksheets("WAREA").Range("A1").AutoFilter
         Else
             Exit Sub: Rem textbox1にリストに対する値がなかった場合の処理
         End If
     End With
 End Sub
　
TEMPシートを追加した上で試してください。
あと、オブジェクト名の編集も。
(みやほりん)(-_∂)b　
返事が遅くなり申し訳ありませんんでした。
先ほど、出張から帰社いたしまして、早速修正したところ動くようになりました。
中々と上手く伝わらず、ご迷惑をお掛けしました。
本当に色々とご指導ありがとうございました。

『ListBoxの日付検索方法について教えて下さい。』（VBA勉強中） 

 返信時は以前の内容を消さないように編集してください。
消された内容を復活しました。
(みやほりん)(-_∂)b
コメント返信：

[ 一覧(最新更新順) ]

YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.