青 色 申 告 決 算 書 の 所 得 解 析 用 ファイルに 組 み 込 まれたマクロについて (ファイル 名 :DB 解 析 マクロ) 青 色 申 告 決 算 書 の 所 得 解 析 用 ファイルに 組 み 込 まれたマクロ(ファイル 名 :DB 解 析 マ クロ)では 付 随 する 作 業 についてボタン 操 作 のみで 対 応 させている ここでは ブック に 組 み 込 まれたマクロについて 解 説 する マクロは Excel に 付 随 する VBE(Visual Basic Editor)で 変 更 が 可 能 である( 図 1) 組 み 込 まれたマクロは ボタンごとに 3 つの Module (VBA(Visual Basic Application)プログラムを 構 成 する 部 品 )に 格 納 されている ここ では 将 来 的 な 改 造 を 念 頭 におき 個 々の 処 理 を 小 さな 単 位 に 区 分 し 階 層 構 造 にしてプ ログラミングする 手 法 を 採 用 している < 標 準 Module> DB 解 析 マクロ 内 のボタンに 応 じて 3 区 分 している Sub~ プログラムの 単 位 (プロシージャと 称 する) 図 1 VBE(Visual Basic Editor)の 画 面 マクロは Sub プロシージャから 実 行 される 一 連 の VBA プログラムである 一 般 に VBA プログラ ム Sub プロシージャは マクロと 称 されることから 報 告 書 内 では Sub プロシージャ を マクロ と 統 一 して 称 することにする 1
Module1 には 損 益 入 力 シートのデータに 関 連 するマクロが 格 納 されている( 表 1) 以 下 に Module1 を 構 成 するマクロを 掲 載 する 表 1 Module1 の 構 成 Module 設 置 されたシート 名 登 録 されたマクロ 作 業 内 容 データの 登 録 ボタン 損 益 入 力 シートに 貼 り 付 けた 損 益 計 算 書 データを DB1 シートに 登 録 する 消 去 ボタン 損 益 入 力 シートに 貼 り 付 けた 損 益 計 算 書 データを 消 去 する 抽 出 1 損 益 入 力 シートで 選 択 された 損 益 計 算 書 データを 抽 出 1 シートに 抽 出 する Module 1 損 益 入 力 抽 出 ボタン1 抽 出 3 損 益 入 力 シートで 選 択 された 収 入 内 訳 データを 抽 出 3 シートに 抽 出 する 抽 出 2 DB1 シートの 損 益 計 算 書 データを 抽 出 2 シートに 抽 出 する 抽 出 ボタン2 抽 出 4 DB2 シートの 損 益 計 算 書 データを 抽 出 4 シートに 抽 出 する ----------------------------------------------------------------------------------------------------------------------------------------------- Sub 登 録 () '1~4 行 目 : 変 数 を 宣 言 (Long: 長 整 数 型 Variant:バリアント 型 Integer: 整 数 型 ) '5~6 行 目 :DB1 シートのセル A1 からの 最 終 行 数 / 列 数 を 取 得 '7~10 行 目 : 損 益 入 力 シートのセル C2~C3 E7~E23 J7~J24 P7~P9 W6 P11~P14 W7 P16~P19 の 配 列 を 作 成 し 変 数 dat に 格 納 '11~13 行 目 : 変 数 dat に 格 納 されたセルの 値 を DB1 シートの 左 端 列 から 順 番 に 登 録 '14 行 目 : 登 録 しました というメッセージを 表 示 Dim x As Long Dim y As Long Dim dat() As Variant Dim i As Integer x = Range("DB1!A1").CurrentRegion.Rows.Count y = Range("DB1!A1").CurrentRegion.Columns.Count dat = Array("C2", "C3", "E7", "E8", "E9", "E10", "E11", "E12", "E13", "E14", "E15", "E16", "E17", "E18", "E19", "E20", "E21", "E22", "E23", _ "J7", "J8", "J9", "J10", "J11", "J12", "J13", "J14", "J15", "J16", "J17", "J18", "J19", "J20", "J21", "J22", "J23", "J24", _ "P7", "P8", "P9", "W6", "P11", "P12", "P13", "P14", "W7", "P16", "P17", "P18", "P19") 2
For i = 0 To y - 1 Range("DB1!a" & x).offset(1, i).value = Range(dat(i)).Value Next i MsgBox " 登 録 しました" Sub 消 去 () '1 行 目 : 損 益 入 力 シートをアクティブに '2 行 目 :セル C2 を 選 択 '3 行 目 :セル C2~C3 E7~E9 E11~E12 E14~E23 J7~J19 J21~J23 P8~P10 P12~P15 P18 の 範 囲 を 選 択 '5 行 目 :セル C2 を 選 択 Worksheets(" 損 益 入 力 ").Activate Range("C2").Select Application.Union(Selection,Range("C2:C3,E7:E9,E11:E12,E14:E23,J7:J19,J21:J23,P8:P10,P12:P15,P18")).Sel ect Range("C2").Select Sub 抽 出 ボタン 1() '1 行 目 : 損 益 入 力 シートを 選 択 '2~8 行 目 :セル Y13 の 値 が 0 でなく かつ セル Z13 の 値 が 0 でない 場 合 マクロ 抽 出 1 マクロ 抽 出 3 の 順 に 処 理 し 抽 出 しました というメッセージを 表 示 上 記 の 条 件 でない 場 合 一 致 するデータがありません というメッセージを 表 示 Sheets(" 損 益 入 力 ").Select If Range("Y13") <> 0 And Range("Z13") <> 0 Then 抽 出 1 抽 出 3 MsgBox " 抽 出 しました" Else MsgBox " 一 致 するデータがありません" End If Sub 抽 出 ボタン 2() '1 行 目 : 損 益 入 力 シートを 選 択 3
'2~8 行 目 :セル Y18 の 値 が 0 でなく かつ セル Z18 の 値 が 0 でない 場 合 マクロ 抽 出 2 マクロ 抽 出 4 の 順 に 処 理 し 抽 出 しました というメッセージを 表 示 上 記 の 条 件 でない 場 合 一 致 するデータがありません というメッセージを 表 示 Sheets(" 損 益 入 力 ").Select If Range("Y18") <> 0 And Range("Z18") <> 0 Then 抽 出 2 抽 出 4 MsgBox " 抽 出 しました" Else MsgBox " 一 致 するデータがありません" End If Sub 抽 出 1() '1 行 目 : 抽 出 1 シートをアクティブに '2 行 目 :セル A3 を 選 択 '3 行 目 :セル A3~AX4 の 範 囲 を 選 択 '5 行 目 :DB1 シートのセル A1 を 含 むアクティブセル 領 域 について 以 下 を 実 行 '6~8 行 目 : 損 益 入 力 シートの V12~W13 で 設 定 した 条 件 のもとで 該 当 するレコードを 抽 出 抽 出 されたレコ ードを 抽 出 1 の A3 以 降 に 貼 り 付 け Sheets(" 抽 出 1").Activate ActiveSheet.Range("A3").Select Application.Union(Selection, Range("A3:AX4")).Select Range("DB1!A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range(" 損 益 入 力!V12:W13").CurrentRegion, _ CopytoRange:=Range(" 抽 出 1!A3"), unique:=true Sub 抽 出 2() '1 行 目 : 抽 出 2 シートをアクティブに '2 行 目 :セル A3 を 選 択 '3 行 目 :セル A3~AX4 の 範 囲 を 選 択 '5 行 目 :DB1 シートのセル A1 を 含 むアクティブセル 領 域 について 以 下 を 実 行 '6~8 行 目 : 損 益 入 力 シートの V17~W18 で 設 定 した 条 件 のもとで 該 当 するレコードを 抽 出 抽 出 されたレコ 4
ードを 抽 出 2 の A3 以 降 に 貼 り 付 け Sheets(" 抽 出 2").Activate ActiveSheet.Range("A3").Select Application.Union(Selection, Range("A3:AX4")).Select Range("DB1!A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range(" 損 益 入 力!V17:W18").CurrentRegion, _ CopytoRange:=Range(" 抽 出 2!A3"), unique:=true 5
Module2 には 内 訳 入 力 シートのデータに 関 連 するマクロが 格 納 されている( 表 2) 以 下 に Module2 を 構 成 するマクロを 掲 載 する 表 2 Module2 の 構 成 Module 設 置 されたシート 名 登 録 されたマクロ 作 業 内 容 Module 2 内 訳 入 力 登 録 ボタン 消 去 ボタン 内 訳 入 力 シートに 貼 り 付 けた 収 入 金 額 内 訳 データを DB2 シートに 登 録 する 内 訳 入 力 シートに 貼 り 付 けた 収 入 金 額 内 訳 データを 消 去 する ----------------------------------------------------------------------------------------------------------------------------------------------- Sub 登 録 2() '1~4 行 目 : 変 数 を 宣 言 (Long: 長 整 数 型 Variant:バリアント 型 Integer: 整 数 型 ) '5~6 行 目 :DB2 シートのセル A1 からの 最 終 行 数 / 列 数 を 取 得 '7~13 行 目 : 内 訳 入 力 シートのセル D2~D3 P8~P35 T6~T9 D8~D36 Q8~Q34 の 配 列 を 作 成 し 変 数 dat に 格 納 '14~16 行 目 : 変 数 dat に 格 納 されたセルの 値 を DB2 シートの 左 端 列 から 順 番 に 登 録 '17 行 目 : 登 録 しました というメッセージを 表 示 Dim x As Long Dim y As Long Dim dat() As Variant Dim i As Integer x = Range("DB2!A1").CurrentRegion.Rows.Count y = Range("DB2!A1").CurrentRegion.Columns.Count dat = Array("D2", "D3", "P8", "P9", "P10", "P11", "P12", "P13", "P14", "P15", "P16", "P17", "P18", "P19", _ "P20", "P21", "P22", "P23", "P24", "P25", "P26", "P27", "P28", "P29", "P30", "P31", "P32", "P33", "P34", "P35", _ "T6", "T7", "T8", "T9", _ "D8", "D9", "D10", "D11", "D12", "D13", "D14", "D15", "D16", "D17", "D18", "D19", "D20", "D21", "D22", "D23", _ "D24", "D25", "D26", "D27", "D28", "D29", "D30", "D31", "D32", "D33", "D34", "D36", _ "Q8", "Q9", "Q10", "Q11", "Q12", "Q13", "Q14", "Q15", "Q16", "Q17", "Q18", "Q19", "Q20", "Q21", "Q22", "Q23", _ "Q24", "Q25", "Q26", "Q27", "Q28", "Q29", "Q30", "Q31", "Q32", "Q33", "Q34") For i = 0 To y - 1 Range("DB2!a" & x).offset(1, i).value = Range(dat(i)).Value Next i MsgBox " 登 録 しました" Sub 消 去 2() 6
'1 行 目 : 内 訳 入 力 シートをアクティブに '2 行 目 :セル D8 を 選 択 '3 行 目 :セル D8~K36 N7~N17 の 範 囲 を 選 択 '5 行 目 :セル D8 を 選 択 Worksheets(" 内 訳 入 力 ").Activate Range("D8").Select Application.Union(Selection, Range("D8:K36,N7:N17")).Select Range("D8").Select Sub 抽 出 3() '1 行 目 : 抽 出 3 シートをアクティブに '2 行 目 :セル A3 を 選 択 '3 行 目 :セル A2~CK3 の 範 囲 を 選 択 '5 行 目 :DB2 シートのセル A1 を 含 むアクティブセル 領 域 について 以 下 を 実 行 '6~8 行 目 : 損 益 入 力 シートの V12~W13 で 設 定 した 条 件 のもとで 該 当 するレコードを 抽 出 抽 出 されたレコ ードを 抽 出 3 の A2 以 降 に 貼 り 付 け '9 行 目 : 損 益 入 力 シートを 選 択 Sheets(" 抽 出 3").Activate ActiveSheet.Range("A3").Select Application.Union(Selection, Range("A2:CK3")).Select Range("DB2!A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range(" 損 益 入 力!V12:W13").CurrentRegion, _ CopytoRange:=Range(" 抽 出 3!A2"), unique:=true Sheets(" 損 益 入 力 ").Select Sub 抽 出 4() '1 行 目 : 抽 出 4 シートをアクティブに '2 行 目 :セル A3 を 選 択 '3 行 目 :セル A2~CK3 の 範 囲 を 選 択 '5 行 目 :DB2 シートのセル A1 を 含 むアクティブセル 領 域 について 以 下 を 実 行 7
'6~8 行 目 : 損 益 入 力 シートの V17~W18 で 設 定 した 条 件 のもとで 該 当 するレコードを 抽 出 抽 出 されたレコ ードを 抽 出 4 の A2 以 降 に 貼 り 付 け '9 行 目 : 損 益 入 力 シートを 選 択 Sheets(" 抽 出 4").Activate ActiveSheet.Range("A3").Select Application.Union(Selection, Range("A2:CK3")).Select Range("DB2!A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range(" 損 益 入 力!V17:W18").CurrentRegion, _ CopytoRange:=Range(" 抽 出 4!A2"), unique:=true Sheets(" 損 益 入 力 ").Select 8
Module3 には グラフ シート 内 の 作 業 に 関 連 するマクロが 格 納 されている( 表 3) 以 下 に Module3 を 構 成 するマクロを 掲 載 する 表 3 Module3 の 構 成 Module 設 置 されたシート 名 登 録 されたマクロ 作 業 内 容 Module 3 グラフ グラフ 軸 統 一 印 刷 プレビューの 表 示 グラフ シート 内 で 基 準 値 を 示 したグラフと 実 績 値 を 示 した グラフの 縦 軸 の 目 盛 りを 統 一 する グラフ シートの 印 刷 プレビュー 画 面 を 表 示 する ----------------------------------------------------------------------------------------------------------------------------------------------- <Module3> Sub グラフ 軸 統 一 () '1 行 目 : グラフ シートを 選 択 '2 行 目 :シート 内 左 側 のグラフをアクティブに '3~7 行 目 : 左 側 グラフの 縦 軸 について 最 小 値 をセル AE44 の 値 にし 最 大 値 をセル AE44 の 値 に '8~12 行 目 : 右 側 グラフの 縦 軸 について 最 小 値 をセル AE44 の 値 にし 最 大 値 をセル AE44 の 値 に '13 行 目 :セル A2 を 選 択 Sheets("グラフ").Select ActiveSheet.ChartObjects(1).Activate ActiveChart.Axes(xlValue).Select With ActiveChart.Axes(xlValue).MinimumScale = Range("AE44").MaximumScale = Range("AE43") End With ActiveSheet.ChartObjects(2).Activate With ActiveChart.Axes(xlValue).MinimumScale = Range("AE44").MaximumScale = Range("AE43") End With Range("A2").Select Sub 印 刷 プレビューの 表 示 () '1 行 目 : グラフ シートの 印 刷 プレビュー 画 面 を 表 示 Worksheets("グラフ").PrintPreview 9