[[20160427124747]] 『オートフィルタ(年月)の結果ごとにシートを作成』(pp) ページの最後に飛ぶ

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

 

『オートフィルタ(年月)の結果ごとにシートを作成する』(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 >


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
    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


mm様、β様、ありがとうございました。
大変大変助かりました。
基礎知識なく業務上必要に迫られてコードを書いていますが
この度不勉強を痛感いたしました。
取り急ぎ御礼申し上げます。
(pp) 2016/04/27(水) 15:41

コメント返信:

[ 一覧(最新更新順) ]


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