| |
A列に下記のような日付データがあるとして、
Ｃ１に抽出したい西暦年
Ｅ１に抽出したい月
Ｇ１に抽出したい月 を記入しこれを参照して抽出します。。
（下記データは、並び替えた方が解りやすいかも）
単にマクロでフィルタをしているだけです。
A
日付 ←１行目タイトル
1月15日 表示形式は、どれでもいいです。
1月16日
1月17日
1月18日
1月19日
1月20日
2005/2/2
2005/2/3
2005/2/5
2005/2/6
2005/3/3
2005/3/4
2005/5/5
2005/5/6
2005/5/7
2005/8/6
2005/8/7
2005/8/8
2005/10/10
2005/10/12
2005/10/20
2005/11/11
2005/11/23
2005/12/1
2005/12/31
2005/1/30
2005/2/28
2005/10/1
2005/12/12
2004/1/10
2004/2/29
2004/5/31
2004/11/1
2004/12/12
2005/1/10
2005/1/11
2005/1/12
2004/1/1
2004/1/2
2004/1/3
2004/2/2
2004/2/3
2004/2/4
2004/3/3
2004/3/4
2004/3/5
2004/4/4
2004/4/5
2004/4/6
2004/5/25
2004/5/26
2004/5/27
*****************************
Sub 日付でフィルタ()
Dim 年 As Integer, 月 As Integer, 日 As Integer, ALast As Long
Dim 年月日 As String
年 = Range("C1").Value
月 = Range("E1").Value
日 = Range("G1").Value
年月日 = 年 & "/" & 月 & "/" & 日
ALast = Range("A65536").End(xlUp).Row
If Application.CountIf(Range("A2:A" & ALast), 年月日) = 0 Then
MsgBox 年月日 & " の物は有りません。"
Exit Sub
End If
'１日分の抽出でもxlAndで、２つ指定する。
Range("A1:A" & ALast).AutoFilter Field:=1, Criteria1:=">=" & 年月日, _
Operator:=xlAnd, Criteria2:="<=" & 年月日
MsgBox 年月日 & " の物を抽出しました。"
End Sub
*****************************
'ここだけ抽出日を直接コードに書きました。
Sub 期間でフィルタ()
Dim 日付1 As String, 日付2 As String
日付1 = "2005/2/2"
日付2 = "2005/5/6"
ALast = Range("A65536").End(xlUp).Row
If Application.CountIf(Range("A2:A" & ALast), ">=" & 日付1) - _
Application.CountIf(Range("A2:A" & ALast), ">" & 日付2) = 0 Then
MsgBox 日付1 & "〜" & 日付2 & " の物は有りません。"
Exit Sub
End If
Range("A1:A" & ALast).AutoFilter Field:=1, Criteria1:=">=" & 日付1, _
Operator:=xlAnd, Criteria2:="<=" & 日付2
MsgBox 日付1 & "〜" & 日付2 & " の物を抽出しました。"
End Sub
*****************************
'ＩＶ列を作業列に使用。
Sub 月でフィルタ()
Dim Strtday As String, Endday As String, ALast As Long
Dim 月 As String, Rafi As Range
ActiveSheet.AutoFilterMode = False
月 = Range("E1").Value
ALast = Range("A65536").End(xlUp).Row
Range("IV2:IV" & ALast).Formula = "=MONTH(A2)"
If Application.CountIf(Columns(256), 月) = 0 Then
Columns(256).Delete
MsgBox 月 & "月の物は有りません。"
Exit Sub
End If
Range("IV1").Value = "XXX"
Range("IV1").AutoFilter Field:=1, Criteria1:=月
MsgBox 月 & "月を抽出しました。"
Set Rafi = Range("A2:A" & ALast).SpecialCells(xlCellTypeVisible)
'ここですぐにIV列をクリアするとフィルタが解除される。
Set Rafi = Nothing
Columns(256).Delete
End Sub
*****************************
Sub 年月でフィルタ()
Dim Strtday As String, Endday As String, ALast As Long
Dim 年 As Integer, 月 As Integer
ActiveSheet.AutoFilterMode = False
'Mth = Application.Match(Range("C1").Value, 0)
年 = Range("C1").Value: 月 = Range("E1").Value
Strtday = 年 & "/" & 月 & "/1"
If IsDate(Strtday) = False Then Exit Sub
Endday = 年 & "/" & 月 & "/" & Format(DateSerial(年, 月 + 1, 1) - 1, "d")
'Endday = StrConv(Endday, vbNarrow)
ALast = Range("A65536").End(xlUp).Row
If Application.CountIf(Range("A2:A" & ALast), ">=" & Strtday) - _
Application.CountIf(Range("A2:A" & ALast), ">" & Endday) = 0 Then
MsgBox 年 & "/" & 月 & "月の物は有りません。"
Exit Sub
End If
Range("A1", Range("A65535").End(xlUp)).AutoFilter Field:=1, Criteria1:=">=" _
& Strtday, Operator:=xlAnd, Criteria2:="<=" & Endday
MsgBox 年 & "/" & 月 & " を抽出しました。"
End Sub
*****************************
上記コードは、オートフィルタしたままにしてあるので解除する時に使用。
Sub 解除()
ActiveSheet.AutoFilterMode = False
End Sub
|
|
![[未読]](./data/FAQ/image/read_icon.gif){kind=icon}
