[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『オートフィルタ(年月)の結果ごとにシートを作成する』(pp)
C列にyyyy/mm/ddが入っています。
実際のデータは2015/4/30〜2016/3/31(2015年度)です。
同じ年月ごとのデータを抽出してシートを作成させたいのですが
下記だと2016年1月〜3月のデータのみコピーされません。
どうしたら良いでしょうか?
なお、できればシートの並び順を4月〜12月、1月、2月、3月としたいです。
(現在は1月〜12月)
どなたかよろしくお願いいたします。
Option Base 1
Option Explicit
Sub 月別シート分割()
Dim 元シート As Worksheet Dim 列幅() As Variant Dim 条件列 As Integer Dim 年 As Long Dim 条件1 As String, 条件2 As String Dim i As Integer, j As Integer
Set 元シート = ActiveSheet ActiveCell.CurrentRegion.Select
ReDim 列幅(Selection.Columns.Count) For i = 1 To Selection.Columns.Count 列幅(i) = Selection.Cells(, i).ColumnWidth Next
条件列 = 3 年 = Year(ActiveCell.Offset(1, 条件列 - 1)) If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
For i = 1 To 12 Sheets.Add Before:=Sheets(i) ActiveSheet.Name = i & "月"
条件1 = ">=" & DateSerial(年, i, 1) 条件2 = "<=" & DateSerial(年, i + 1, 1)
元シート.Activate ActiveCell.CurrentRegion.Select Selection.AutoFilter Field:=条件列, Criteria1:=条件1, Operator:=xlAnd, Criteria2:=条件2 Selection.SpecialCells(xlCellTypeVisible).Copy Sheets(i).Range("A1").PasteSpecial
For j = 1 To Selection.Columns.Count Sheets(i).Cells(, j).ColumnWidth = 列幅(j) Next j Next i
Selection.AutoFilter Sheets(1).Activate
End Sub
< 使用 Excel:Excel2010、使用 OS:Windows7 >
Dim 元シート As Worksheet Dim 列幅() As Variant Dim 条件列 As Integer Dim 年 As Long Dim 条件1 As String, 条件2 As String Dim i As Integer, j As Integer Dim d As Date
Set 元シート = ActiveSheet ActiveCell.CurrentRegion.Select
ReDim 列幅(Selection.Columns.Count) For i = 1 To Selection.Columns.Count 列幅(i) = Selection.Cells(, i).ColumnWidth Next
条件列 = 3
If ActiveSheet.AutoFilterMode Then Selection.AutoFilter
For i = 1 To 12
d = DateAdd("m", i - 1, ActiveCell.Offset(1, 条件列 - 1)) 年 = Year(d)
Sheets.Add Before:=Sheets(i) ActiveSheet.Name = Month(d) & "月"
条件1 = ">=" & DateSerial(年, Month(d), 1) 条件2 = "<=" & DateSerial(年, Month(d) + 1, 1)
元シート.Activate ActiveCell.CurrentRegion.Select Selection.AutoFilter Field:=条件列, Criteria1:=条件1, Operator:=xlAnd, Criteria2:=条件2 Selection.SpecialCells(xlCellTypeVisible).Copy Sheets(i).Range("A1").PasteSpecial
For j = 1 To Selection.Columns.Count Sheets(i).Cells(, j).ColumnWidth = 列幅(j) Next j
Next i
Selection.AutoFilter Sheets(1).Activate End Sub (mm) 2016/04/27(水) 14:46
コード自体は、あぶなっかしいというか、もっと改善したほうがいいところが多々ありますが、さておき。
最初に 年 という変数にセットしているのはC列の最初の日付セルの年になってますね。 実際のデータが2015/4/30〜2016/3/31ということですから、年は 2015/4/30の年、つまり 2015年になっています。 1月〜3月のデータの日付は、当然 2016年ですから、2015年1月といったもので抽出しても空振りですね。
それと、条件2 = "<=" & DateSerial(年, i + 1, 1) たとえば 1月の場合、2月1日までになりますね。(<= ですから) これって、具合悪いですね。
コード自体は mmさんからアップ済みですので、私からアップするのは控えますが、↑でコメントしたことは しっかりと、元コードをチェックしておいてくださいね。
それと、これは私見ですけど、Option Base 1。 たしかに、この記述をすることで LBound を省略した ReDim 列幅(Selection.Columns.Count) この記述で、LBound が 1 の配列が生成されますが、感心しません。
Option Base 1 の記述にかかわらず、LBound が 0 になるケース、LBound が 1になるケースがたくさんあります。 むしろ、Option Base 1 によって LBound が影響受けるコードは少数派です。
保守上、紛らわしくなると思っています。
Option Base 1 は記述しない。 配列定義は ReDim 列幅(1 To Selection.Columns.Count) と、必ず LBound を明記する。
これがβの考え方です。
(β) 2016/04/27(水) 15:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.