[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フィルターで日付を認識しない。』（Tri）
お世話になります。まずSheet3にユーザーフォームで各項目を登録しています。
Private Sub CommandButton2_Click()
If ComboBox1.Value = "" Then
MsgBox "セットを選択してください。"
Else
Dim i As Integer
Dim j As Integer
Dim ans As Integer
ans = MsgBox("登録します。よろしいですか？", vbYesNo + vbExclamation, "登録確認")
If ans = vbYes Then
For i = 3 To 10000
’Sheet3は3番目のシート
If Sheet3.Cells(i, "A") = "" Then
Sheet3.Cells(i, "A") = TextBox1.Value
Sheet3.Cells(i, "B") = Year(TextBox1.Value)
Sheet3.Cells(i, "C") = Month(TextBox1.Value)
Sheet3.Cells(i, "D") = Day(TextBox1.Value)
Sheet20.Select
Exit For
End If
Next
End If
End If
'並べ替え
Sheet3.Select
Columns("A:AR").EntireColumn.AutoFit
Range("A3:AR10000").Sort key1:=Range("A3"), order1:=xlDescending, Header:=xlGuess
Sheet20.Select
Sheet1.Range("J6").Value = "登録済"
End Sub
シート3のA列は日付としているのですが登録した際、年月日で登録されます。
Private Sub CommandButton14_Click()
'今年
ScreenUpdating = False
MsgBox "検索します。お待ちください。"
With Sheets("今年")
.Range("H3:AO7") = ClearContents
.Range("D10:AI40") = ClearContents
End With
Dim i As Integer
With Sheets("検索結果")
.Range("A2:AR5000") = ClearContents
End With
Sheet3.Select
With ActiveSheet
.Range("A2:AB2").Select
Selection.AutoFilter
Selection.AutoFilter field:=1, Criteria1:=xlFilterThisYear, Operator:=xlFilterDynamic
.Range("A3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheets("検索結果").Range("A1")
.AutoFilterMode = False
End With
' Sheets("検索結果").Activate
' Columns("A:AX").EntireColumn.AutoFit
'Range("A2:AR10000").Sort key1:=Range("A2"), order1:=xlDescending, Header:=xlGuess
ScreenUpdating = True
Sheets("検索結果").Activate
For i = 2 To 40
With ActiveSheet
Sheets("今年").Range("D10:D40").Value = .Range("C2:C40").Value
Sheets("今年").Range("E10:E40").Value = .Range("D2:D40").Value
Sheets("今年").Range("F10:F40").Value = .Range("H2:H40").Value
Sheets("今年").Range("H10:H40").Value = .Range("O2:O40").Value
Sheets("今年").Range("J10:J40").Value = .Range("I2:I40").Value
Sheets("今年").Range("L10:L10").Value = .Range("J2:J40").Value
Sheets("今年").Range("N10:N40").Value = .Range("X2:X40").Value
Sheets("今年").Cells(i + 8, "P").Value = Left(.Cells(i, "V").Value, 2)
Sheets("今年").Range("R10:R40").Value = .Range("U2:U40").Value
Sheets("今年").Range("T10:T40").Value = .Range("M2:M40").Value
Sheets("今年").Range("V10:V40").Value = .Range("N2:N40").Value
Sheets("今年").Range("Z10:Z40").Value = .Range("Z2:Z40").Value
Sheets("今年").Range("AI10:AI40").Value = .Range("AA2:AA40").Value
End With
Next
Application.ScreenUpdating = False
Sheet19.Rows("6:1000").ClearContents
Sheet19.AutoFilterMode = False
Sheet18.Select
With ActiveSheet
Sheet18.Range("A5:Y5").Select
Selection.AutoFilter
Selection.AutoFilter field:=1, Criteria1:=xlFilterThisYear, Operator:=xlFilterDynamic
.Range("A6").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Sheet19.Range("A2")
If Sheet19.Range("A6") = "" Then
Sheets("今年").Select
.AutoFilterMode = False
Exit Sub
End If
.AutoFilterMode = False
End With
Sheet18.Range("B3:Y3").Copy
Sheet19.Select
Sheet19.Range("B3").Select
ActiveSheet.Paste
Sheet19.Range("Z3") = WorksheetFunction.Sum(Range("B3:Y3"))
'1月
Sheet19.Range("Z6").Copy
Sheet10.Select
Sheet10.Range("H3").Select
ActiveSheet.Paste
'2月
Sheet19.Range("Z7").Copy
Sheet10.Select
Sheet10.Range("K3").Select
ActiveSheet.Paste
'3月
Sheet19.Range("Z8").Copy
Sheet10.Select
Sheet10.Range("N3").Select
ActiveSheet.Paste
'4月
Sheet19.Range("Z9").Copy
Sheet10.Select
Sheet10.Range("Q3").Select
ActiveSheet.Paste
'5月
Sheet19.Range("Z10").Copy
Sheet10.Select
Sheet10.Range("T3").Select
ActiveSheet.Paste
'6月
Sheet19.Range("Z11").Copy
Sheet10.Select
Sheet10.Range("W3").Select
ActiveSheet.Paste
'7月
Sheet19.Range("Z12").Copy
Sheet10.Select
Sheet10.Range("Z3").Select
ActiveSheet.Paste
'8月
Sheet19.Range("Z13").Copy
Sheet10.Select
Sheet10.Range("AC3").Select
ActiveSheet.Paste
'9月
Sheet19.Range("Z14").Copy
Sheet10.Select
Sheet10.Range("AF3").Select
ActiveSheet.Paste
'10月
Sheet19.Range("Z15").Copy
Sheet10.Select
Sheet10.Range("AI3").Select
ActiveSheet.Paste
'11月
Sheet19.Range("Z16").Copy
Sheet10.Select
Sheet10.Range("AL3").Select
ActiveSheet.Paste
'12月
Sheet19.Range("Z17").Copy
Sheet10.Select
Sheet10.Range("AO3").Select
ActiveSheet.Paste
i = 8
For j = 1 To 12
With Sheets("今年")
.Cells(4, i).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 1)
i = i + 3
End With
Next
i = 8
For j = 1 To 12
With Sheets("今年")
.Cells(5, i).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 2)
i = i + 3
End With
Next
Sheets("今年").Activate
Dim s, sp As Double
On Error Resume Next
s = 6
For sp = 8 To 44
With Sheets("今年")
.Cells(6, sp).Value = ((.Cells(s - 3, sp) - .Cells(s - 2, sp) - .Cells(s - 1, sp)) / .Cells(s - 3, sp))
End With
Next
Next
Application.ScreenUpdating = True
End Sub
CommandButton14で検索をかけた場合、登録したのが年月日で登録しておりSheet3のA列のものをyyyy/mm/dd形式にするとヒットします。形式をあわせればいいのでしょうが、年月日、yyyy/mm/ddどちらもヒットする対策はありますでしょうか？
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
■１
＞’Sheet3は3番目のシート
↑のようなメッセージにするならオブジェクト名で指定するのはやめたらどうですか？
■２
VBAの世界では基本的にシートやセルをきちんと明示すれば、いちいち選択したりアクティブにしたりする必要はありません。
また、標準モジュールやユーザーフォームモジュールでシートを指定しなかった場合、アクティブシートを指定したものとみなされるルールです。
したがって、きちんとシートなどのオブジェクトを指定するように記述すると、全体が見やすくなってデバッグ作業の効率が上がるかと思います。
■３
提示されたコードを見るとインデントが付いてない（あるいは適当である）ようにおもいます。
インデントの有無が実行上に影響をあたえるものではありませんが、適切にインデントを付けておくと全体が把握しやすくなり、ご自身のデバッグ作業の効率アップに寄与すると思います。
■４
↓のような書き方は
Dim s, sp As Double Dim s as Variant, sp As Double ↑のように解釈されます。
両方を「Double」型にしたいのであれば↓のように記述する必要があります。
Dim s As Double, sp As Double
■５
質問のほうは"検索"ではなく、【オートフィルタ】で【日付】を条件に【抽出】したいのだとおもいます。
実は、オートフィルタで日付を抽出するにはちょっとコツが必要です。
まずは↓を読んでみて理屈がわかったら【期間】で取り出すことを考えてみてください
http://officetanaka.net/excel/vba/tips/tips151.htm
例えば、「2022/4/24」を抽出したいのであれば
「2022/4/24【以降】」かつ「2022/4/25【より前】」を取り出せばよいです。
（もこな２） 2022/04/24(日) 20:59
Private Sub CommandButton2_Click()
Dim i As Integer
With Worksheets(3) 'Sheet3は3番目のシート
If ComboBox1.Value = "" Then
MsgBox "セットを選択してください。"
Else
If MsgBox("登録します。よろしいですか？", vbYesNo + vbExclamation, "登録確認") = vbYes Then
For i = 3 To 10000
If .Cells(i, "A") = "" Then
.Cells(i, "A") = TextBox1.Value
.Cells(i, "B") = Year(TextBox1.Value)
.Cells(i, "C") = Month(TextBox1.Value)
.Cells(i, "D") = Day(TextBox1.Value)
Sheet20.Select
Exit For
End If
Next i
End If
End If
'並べ替え
.Columns("A:AR").EntireColumn.AutoFit
.Range("A3:AR10000").Sort key1:=Range("A3"), order1:=xlDescending, Header:=xlGuess
End With
Sheet20.Select
Sheet1.Range("J6").Value = "登録済"
End Sub
'===========================================================
Private Sub CommandButton14_Click()
Dim i As Integer, j As Long
'今年
'Application.ScreenUpdating = False
MsgBox "検索します。お待ちください。"
Sheets("今年").Range("H3:AO7,D10:AI40").ClearContents '記述ミスっぽいので修正
Sheets("検索結果").Range("A2:AR5000").ClearContents '記述ミスっぽいので修正
With Sheet3
.AutoFilterMode = False 'オートフィルタ強制解除
.Range("A2:AB2").AutoFilter 'オートフィルタ設定
With .AutoFilter.Range
.AutoFilter field:=1, Criteria1:=xlFilterThisYear, Operator:=xlFilterDynamic
.Copy Sheets("検索結果").Range("A1")
End With
.AutoFilterMode = False
End With
'Application.ScreenUpdating = True
With Sheets("検索結果")
For i = 2 To 40
Sheets("今年").Range("D10:D40").Value = .Range("C2:C40").Value
Sheets("今年").Range("E10:E40").Value = .Range("D2:D40").Value
Sheets("今年").Range("F10:F40").Value = .Range("H2:H40").Value
Sheets("今年").Range("H10:H40").Value = .Range("O2:O40").Value
Sheets("今年").Range("J10:J40").Value = .Range("I2:I40").Value
Sheets("今年").Range("L10:L10").Value = .Range("J2:J40").Value
Sheets("今年").Range("N10:N40").Value = .Range("X2:X40").Value
Sheets("今年").Cells(i + 8, "P").Value = Left(.Cells(i, "V").Value, 2)
Sheets("今年").Range("R10:R40").Value = .Range("U2:U40").Value
Sheets("今年").Range("T10:T40").Value = .Range("M2:M40").Value
Sheets("今年").Range("V10:V40").Value = .Range("N2:N40").Value
Sheets("今年").Range("Z10:Z40").Value = .Range("Z2:Z40").Value
Sheets("今年").Range("AI10:AI40").Value = .Range("AA2:AA40").Value
Next i
End With
'Application.ScreenUpdating = False
Sheet19.Rows("6:1000").ClearContents
Sheet19.AutoFilterMode = False
With Sheet18
.AutoFilterMode = False
.Range("A5:Y5").AutoFilter
With .AutoFilter.Range
.AutoFilter field:=1, Criteria1:=xlFilterThisYear, Operator:=xlFilterDynamic
.Copy Sheet19.Range("A2")
End With
.AutoFilterMode = False
End With
If Sheet19.Range("A6") = "" Then
Sheets("今年").AutoFilterMode = False
Sheets("今年").Select
Exit Sub
End If
Sheet18.Range("B3:Y3").Copy Sheet19.Range("B3")
Sheet19.Range("Z3") = WorksheetFunction.Sum(Sheet19.Range("B3:Y3"))
'▼ここからループ処理にしてもいいかも
Sheet19.Range("Z6").Copy Sheet10.Range("H3") '1月
Sheet19.Range("Z7").Copy Sheet10.Range("K3") '2月
Sheet19.Range("Z8").Copy Sheet10.Range("N3") '3月
Sheet19.Range("Z9").Copy Sheet10.Range("Q3") '4月
Sheet19.Range("Z10").Copy Sheet10.Range("T3") '5月
Sheet19.Range("Z11").Copy Sheet10.Range("W3") '6月
Sheet19.Range("Z12").Copy Sheet10.Range("Z3") '7月
Sheet19.Range("Z13").Copy Sheet10.Range("AC3") '8月
Sheet19.Range("Z14").Copy Sheet10.Range("AF3") '9月
Sheet19.Range("Z15").Copy Sheet10.Range("AI3") '10月
Sheet19.Range("Z16").Copy Sheet10.Range("AL3") '11月
Sheet19.Range("Z17").Copy Sheet10.Range("AO3") '12月
Dim s As Long, sp As Long 'どちらも整数型で事足りる
i = 8
With Sheets("今年")
For j = 1 To 12
.Cells(4, i).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 1)
.Cells(5, i).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 2)
i = i + 3
Next j
'On Error Resume Next '←意図不明
s = 6
For sp = 8 To 44
.Cells(6, sp).Value = ((.Cells(s - 3, sp) - .Cells(s - 2, sp) - .Cells(s - 1, sp)) / .Cells(s - 3, sp))
Next
End With
'Next ←相方不明
'Application.ScreenUpdating = True
End Sub
（もこな２） 2022/04/24(日) 22:18
↓Excel君の忖度で失敗（エラー発生）はしないとおもいますが、行数が異なっているので意味合い的にはおかしいですよね。
Sheets("今年").Range("D10:D40").Value = .Range("C2:C40").Value
さらに↓以外は、ループ処理の中で38回も全く同じことを繰り返すので無駄です。
Sheets("今年").Cells(i + 8, "P").Value = Left(.Cells(i, "V").Value, 2)
■７
＞Format関数をとりあえず使用してみます。
理解されたのか不明ですが、「CommandButton14_Click」を眺めていて気になったところを直してみました。
興味があれば【ステップ実行】等を行い研究してみて下さい。
（理解していただきたいので、丸パクリして完成！というのはご遠慮下さい。）
ご自身のコードを手直ししていったら、結果として同じになったということならokです。
Private Sub CommandButton14_Click()
Dim i As Integer, j As Long
Dim MyArr1 As Variant, MyArr2 As Variant
Dim MyRNG As Range
Sheets("今年").Range("H3:AO7,D10:AI40").ClearContents
Sheets("検索結果").Range("A2:AR5000").ClearContents
With Sheet3
.AutoFilterMode = False
.Range("A2:AB2").AutoFilter field:=1, Criteria1:=">=" & Format(CDate(TextBox1.Value), "yyyy/m/d"), _
Operator:=xlAnd, _
Criteria2:="<" & Format(CDate(TextBox1.Value) + 1, "yyyy/m/d")
.AutoFilter.Range.Copy Sheets("検索結果").Range("A1")
.AutoFilterMode = False
End With
MyArr1 = Split("D,E,F,H,J,L,N,P,R,T,V,Z,AI", ",")
MyArr2 = Split("C,D,H,O,I,J,X,V,U,M,N,Z,AA", ",")
For i = 0 To UBound(MyArr1)
Sheets("今年").Cells(10, MyArr1(i)).Resize(31).Value = Sheets("検索結果").Cells(2, MyArr2(i)).Resize(31).Value
Next i
For Each MyRNG In Sheets("今年").Range("P10").Resize(31)
MyRNG.Value = Left(MyRNG.Value, 2)
Next MyRNG
With Sheet19
.AutoFilterMode = False
.Rows("6:1000").ClearContents
End With
With Sheet18
.AutoFilterMode = False
.Range("A5:Y5").AutoFilter field:=1, Criteria1:=">=" & Format(CDate(TextBox1.Value), "yyyy/m/d"), _
Operator:=xlAnd, _
Criteria2:="<" & Format(CDate(TextBox1.Value) + 1, "yyyy/m/d")
.AutoFilter.Range.Copy Sheet19.Range("A2")
.AutoFilterMode = False
End With
If Sheet19.Range("A6") = "" Then
Sheets("今年").AutoFilterMode = False
Sheets("今年").Select
Exit Sub
End If
Sheet18.Range("B3:Y3").Copy Sheet19.Range("B3")
Sheet19.Range("Z3") = WorksheetFunction.Sum(Sheet19.Range("B3:Y3"))
With Sheets("今年")
For j = 1 To 12 Step 1
Sheet19.Range("Z6").Offset(j - 1).Copy Sheet10.Range("H3").Offset(, 3 * (j - 1))
.Cells(4, 8).Offset(, 3 * (j - 1)).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 1)
.Cells(5, 8).Offset(, 3 * (j - 1)).Value = WorksheetFunction.CountIfs(.Range("D10:D40"), j, .Range("X10:X40"), 2)
Next j
.Range("H6:AR6").Formula = "=(H3-SUM(H4:H5))/H3"
End With
End Sub
（もこな２ ） 2022/04/26(火) 12:28
>フィルターで日付を認識しない。
Private Sub CommandButton14_Click()
Dim dKey As Date
skey = CDate(Me.TextBox1.Text)
Sheets("検索結果").UsedRange.Clear
With Sheet3.Range("A2")
.AutoFilter field:=1, _
Criteria1:="<=" & skey, _
Operator:=xlAnd, _
Criteria2:="<" & skey
If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.Copy Sheets("検索結果").Range("A1")
End If
.AutoFilter
End With
End Sub
テキストボックスに入る値は、文字通り「文字」です。
エクセルのセルは多機能なので、日付に読める文字列が入力されたら、
自動で日付（シリアル値）に変換されます。
そして、オートフィルターで検索するのも表示されている文字列で検索＆抽出されます。
数値（シリアル値）で検索したければ、比較の演算子を書き足すのがルールです。
日付は該当が１日であっても、「以上であり、以下である」というような条件で
検索するのが常套手段となっています。
サンプルは動作確認してません。間違いがあったらごめんなさいです。
（まっつわん） 2022/04/26(火) 16:41
>Dim dKey As Date
>skey = CDate(Me.TextBox1.Text)
dKeyがskeyの間違いがどして、Date型の変数に入れると 短いほうの日付で処理されないだろうか？
文字列の方がいいのでは。 昔CSVに書き込みソフトを手直ししたので。 （ちびちょんぱ） 2022/04/26(火) 19:43
テストしてないので他にもミスがあるかもしれません。
（もこな２） 2022/04/26(火) 22:59
＞短いほうの日付で処理されないだろうか？
短いでも長いでもよいようにということなので、
というかシリアル値で比較なので、、、、
ちょ、暇だから、サンプルから作って動作確認してみます。
（まっつわん） 2022/04/27(水) 08:07
Private Sub UserForm_Initialize()
With Me.lstResult
.ColumnCount = 2
.ColumnHeads = True
End With
End Sub
'日付入力欄の処理
Private Sub txbKeyWord_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
With Me.txbKeyWord
If IsDate(.Text) Then
.Tag = CDate(.Text)
.Text = Format(.Tag, "ggge年m月d日")
Else
.Text = ""
Cancel = True
End If
End With
End Sub
'抽出ボタン
Private Sub cmdFind_Click()
Dim dKey As Date
'Stop
dKey = Me.txbKeyWord.Tag
ThisWorkbook.Worksheets("Sheet2").UsedRange.Clear
With ThisWorkbook.Worksheets("Sheet1").Range("A2").CurrentRegion
.AutoFilter field:=1, _
Criteria1:="<=" & dKey, _
Operator:=xlAnd, _
Criteria2:=">=" & dKey
If .Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
.Copy Sheets("Sheet2").Range("A1")
End If
.AutoFilter
End With
End Sub
これで、セルの書式設定に依存しないと確認しました。
（いろいろタイプミスがたくさんありました＾＾；）
シリアル値で大きい小さいを比較されるようになるので。
テキストボックスの方はおまけです。
テキストボックスには期待している値以外を入れられないような機能を付けたいかなと思いました。
期待されてる値が入ったら、ボタンを押せて、そうでなければ押せないようにすると
なお使いやすいと思います。
（まっつわん） 2022/04/27(水) 09:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.