Excel VBA 自動作成
事務処理で使用する40のパターンのプログラムを自動作成します。
組み合わせることで、簡単にシステム作成できます。
Excel VBAの利用方法
1. 下記よりダウンロードします。
http://www.vector.co.jp/soft/winnt/business/se369444.html
2.自動M を開きます。
アドインタブに VBA自動作成 が表示されます。
バージョン7.0より 「自」 が 「VBA自動作成」となりました。
XLSXフォーマットに対応し、作成されるプログラムの最終行、最終列の計算部分が変更されました。
例 EN = INS.Range("$A65536").End(xlUp).Row
⇒ EN = INS.Range("$A “& ins.rows.count).End(xlUp).Row
VBA自動作成 を押すと機能を選択するフォームが表示されます。
機能を選択しOKを押します。
処理するセルを選択するフォームに入力することでプログラムが自動作成され、クリップボードにコピーされます。
また「例で練習」を押すとテストデータが新規ブックにコピーされますので、操作を勉強できます。
Excel VBA自動作成の機能ごとに、機能を説明していきます。
はじめに基本的な処理について説明します。
基本編
目次
A.表の形を変える
B.他のシートを参照する
C.加工する
D.計算式を記入する
E.フィルタする
F.分類する
G.集計する
H.セルを修飾する
A. 表の形を変える
入力表の列を加工して別の列に記入します。
または、入力表の内容を別のシートに記入します。
この機能は他の機能と異なり、自由に修正して使用します。
ここでは、A列とC列をつないでE列に記入するプログラムを作成します。
設定方法
プログラムの実行結果は下記となります。
作成されたプログラム
Sub キー作成() Application.ScreenUpdating = False Set INS = Sheets("Sheet2") '入力シート EN = INS.Range("$A65536").End(xlUp).Row For I = 3 To EN KEY = INS.Range("$A" & I).Value '表示されているままキーにするとき.TXT KEY = KEY & "_" & INS.Range("$C" & I).Value INS.Range("$E" & I).Value = KEY Application.StatusBar = I & "<--" & EN Next I Application.StatusBar = "" End Sub |
このプログラムは最も基本的なもので、赤色の部分を変更することで、いろいろな処理に対応できます。
別のシートに出力する場合は、下記のように設定します。
結果 別のシートに4月分のみ出力した例
修正したプログラム
Sub キー作成() Application.ScreenUpdating = False Set INS = Sheets("Sheet2") '入力シート Set OUS = Sheets("Sheet3") '出力シート EN = INS.Range("$A65536").End(xlUp).Row C = 3 For I = 3 To EN If Format(INS.Range("$B" & I).Value, "YYYYMM") = "201604" Then OUS.Range("$A" & C).Value = INS.Range("$A" & I).Value OUS.Range("$B" & C).Value = INS.Range("$D" & I).Value OUS.Range("$C" & C).Value = INS.Range("$B" & I).Value C = C + 1 End If Application.StatusBar = I & "<--" & EN Next I Application.StatusBar = "" End Sub |
この例のように、少し修正することで、いろいろな処理ができます。
キー作成横
横方向にデータを加工します。
入力表
2行目を3行目にコピーします。
設定方法
ここでは5文字を切り取って記入するよう修正してみました。
この機能も目的に応じて修正して使用します。
入力表の必要な列のみを別のシートにコピーします。
入力表にフィルタをかけておくと、表示されているデータのみコピーされます。
入力表
出力表
設定方法
項目名を選択することで、コピーする列を自動的に判断してくれます。
結果
指定した行数を挿入します。
入力表
設定方法
結果(一部)
作成されたプログラム
Sub 行挿入() Application.ScreenUpdating = False Application.CutCopyMode = False 'クリップボードを消去しないと貼りつく Set ins = Sheets("Sheet7") '入力出力シート en = ins.Range("$A65536").End(xlUp).Row For i = en To 3 Step -1 ins.Range("$C" & i + 0) = "個数" ins.Range("$C" & i + 1) = "金額" If i <> 3 Then ins.Rows(i & ":" & i).Insert Shift:=xlDown Application.StatusBar = i & "<--" & en Next i Application.StatusBar = "" End Sub |
B. 他のシートを参照する
他のシートより同じキーを持つデータを検索する。(関数VLOOKUPの機能)
入力表
参照表
設定方法
入力表のA列を参照表のA列から探し、参照表の価格を入力表のC列に記入します。
結果
見つからないと空欄
横方向に並んでいるデータで、他のシートより同じキーを持つデータを検索する。
入力表
参照表
設定方法
ここでは入力表2行目の型式を参照表のA列より探し、価格をもとめ、入力表の3行に記入します。
結果
自動作成されたプログラム
Sub 合成横() Application.ScreenUpdating = False Set INS = Sheets("Sheet10") '入力出力シート ENC = INS.Range("$IV2").End(xlToLeft).Column SENC = INS.Range("$B$2").Column If ENC < SENC Then Exit Sub INS.Range("$B$3").Resize(1, ENC - SENC + 1).ClearContents '出力データクリヤ Set SBK = ThisWorkbook.Sheets("Sheet11") '参照ブックシート For I = SENC To ENC KEYD = INS.Cells(2, I).Value Set F = SBK.Range("$A:$A").Find(What:=KEYD, LookIn:=xlValues, _ LookAt:=xlWhole, MatchCase:=False) If F Is Nothing Then ' INS.CELLS(3, I).Value = "" '見つからない Else INS.Cells(3, I).Value = SBK.Range("$B" & F.Row).Value End If Application.StatusBar = I & "<--" & ENC Next I Application.StatusBar = "" End Sub |
C. 加工する
指定した列のデータを特定の文字で区切ります。
入力表
設定方法
結果
指定した列の文字を置換します。
入力表
設定方法
A列のabc を acc に置換します。
結果
D. 計算式を記入する
全行に計算式を記入します。
入力表
先頭行に計算式を入力しておきます。
設定方法
結果
自動作成されたプログラム
Sub 式コピー() Application.ScreenUpdating = False Set BK = ActiveWorkbook Set INS = BK.Sheets("Sheet13") '入力出力シート ENDROW = INS.Range("$A65536").End(xlUp).Row If ENDROW < 3 Then Exit Sub End If ra = Array("$D", "$E") '''標準書式への変更 For k = LBound(ra) To UBound(ra) INS.Range(ra(k) & "3:" & ra(k) & ENDROW).NumberFormatLocal = "G/標準" Next k INS.Range("$D3").Formula = "=B3*C3" INS.Range("$E3").Formula = "=D3*0.08" For k = LBound(ra) To UBound(ra) INS.Range(ra(k) & "3").Copy INS.Range(ra(k) & "3:" & ra(k) & ENDROW).PasteSpecial Paste:=xlFormulas Next k INS.Calculate ''計算実行 自動計算OFFの場合への対応 End Sub |
入力表
8行目に合計式を記入しておきます。
設定方法
B8:C8 を選択してから設定します。
結果
上と同じ
自動作成されたプログラム
Sub 計算式記録出力() Set INS = Sheets("Sheet14") '入力出力シート EN = INS.Range("$A65536").End(xlUp).Row '最終行の判断 列を修正する '修正方法 最終行9のとき 9-> " & EN &" 10->" & EN +1 &" '修正例 ”=SUM($A3:$A" & EN &") "=F11/G11" -> "F"& EN+2 &"/G"& EN+2 INS.Range("$B" & EN + 2).Formula = "=SUM(B3:B6)" INS.Range("$C" & EN + 2).Formula = "=SUM(C3:C6)" End Sub |
集計範囲を最終行に合わせて変更します。
Sub 計算式記録出力() Set INS = Sheets("Sheet14") '入力出力シート EN = INS.Range("$A65536").End(xlUp).Row '最終行の判断 列を修正する '修正方法 最終行9のとき 9-> " & EN &" 10->" & EN +1 &" '修正例 ”=SUM($A3:$A" & EN &") "=F11/G11" -> "F"& EN+2 &"/G"& EN+2 INS.Range("$B" & EN + 2).Formula = "=SUM(B3:B" & EN &")" INS.Range("$C" & EN + 2).Formula = "=SUM(C3:C" & EN &")" End Sub |
最終列まで計算式をコピーします。
入力表
設定方法
合計をコピーする例
結果
計算式コピーと同じくプログラムの一部修正が必要です。
E. フィルタする
「項目指定列コピー」や「ピボット作成」、「集計統合」の前にデータを絞りこみを行います。
入力表
設定方法
結果
F. 分類する
入力表
設定方法
C順B順の例
結果
G. 集計する
ピボットテーブルで集計し、値貼り付けします。
入力表
出力表
設定方法
型式別、売上月別集計する例
結果
複数の項目を集計します。項目名をもとに貼付列を自動的に求めますので簡単です。
入力表
出力表
設定方法
@ では初めに集計キー項目(C3)を指定します。
結果
キーが重複しているか(何件目か)を調べます。
重複していない場合は0
入力表
設定方法
結果
キー列が同じ範囲で合計を求め、キーの先頭の行に記入します。
プログラムを修正すると、平均値や最大値を記入できます。
入力表
設定方法
結果
自動作成されたプログラム
Sub 同一キー計() Application.ScreenUpdating = False Set INS = Sheets("Sheet8") '入力出力シート EN = INS.Range("$A65536").End(xlUp).Row ST = 3 INS.Range("$D" & ST & ":$D" & EN).ClearContents OKEY = "??????" '1行目と異なる値 I = ST Do While I <= EN + 1 KEY = INS.Range("$A" & I).Value If KEY <> OKEY Or I = EN + 1 Then If I <> ST Then ' INS.Rows(I & ":" & I + 0).Insert Shift:=xlDown 'I行目に行挿入する INS.Range("$D" & K).Value = T '平均なら T/C '' INS.Range("$D" & K).Value = t1 ’別の列の計 ' I=I+1:EN=EN+1 '行挿入した場合カウントアップ End If T = 0 ' T1=0 ’別の列の計クリヤ C = 0 '件数 K = I End If OKEY = KEY T = T + INS.Range("$C" & I).Value ' t1 = t1 + INS.Range("$C" & I).Value ’別の列の計 C = C + 1 '件数カウントアップ 普通使用しない Application.StatusBar = I & "<--" & EN I = I + 1 Loop Application.StatusBar = "" End Sub
|
H. セルを修飾する
特定条件のセルに色を付けます。
入力表
設定方法
4以上の行に色を付けるよう、プログラムを修正します。
結果
キーが同じ範囲で区切り、下線を引きます。
入力表
設定方法
結果