Excel VBA 自動作成

 

 

追加機能編

 

 

目次

 

 

A.表の形を変える    

       ﾏﾄﾘｸｽ作成

       ﾏﾄﾘｸｽ縦表変換

       帳票作成

B.他のシートを参照する     

       合成

       合成縦横

       合成繰返

       合成高速

       合成挿入

       合成貼付

G.集計する   

       集計SUMIF

       行集計

H.セルを修飾する    

       書式コピー

I.ブック、データの取り扱い 

       ﾌｧｲﾙ一覧

       ﾌﾞｯｸ読込書込

       ﾃｷｽﾄ読込書込

J.フォームを作成する

       ﾌｫｰﾑ入力

K.マクロを実行する  

       ﾏｸﾛ実行

       ﾓｰﾄﾞ切替

       データチェック

 

 

 

A.   表の形を変える

 

 

ﾏﾄﾘｸｽ作成

 

縦表(同じ項目は1列しかない)を見やすい横表に変換します。横キーを出力表に見つけ、その列にデータを移動する。

入力表は縦キー順に分類しておきます。

 

入力表

 

出力表

あらかじめ横キーを貼り付けておく必要があります。

 

設定方法

 

 

結果　

ピボットテーブルと異なり、集計しません。横方向に複数項目を貼り付けます。

 

 

ﾏﾄﾘｸｽ縦表変換

 

横表(横方向に同じ項目が並んでいる表)を入力表とするとプログラムが複雑になります。

横表を縦表(同じ項目は1列しかない)に変更します。

 

入力表

 

出力表

 

設定方法

 

結果　

この形ではフィルタや分類など処理が容易になります。

 

 

帳票作成

 

1件のデータを1シートに配置します。

 

入力表

テキストボックスに項目名の名前をつけ、設置します。

記入するデータ

 

設定方法

テキストボックスを配置したシートを選択してから設定してください。

 

結果　

プログラムで表示する行を指定します。5行を指定した例。

 

 

 

B.   他のシートを参照する

 

合成

 

基本編で説明しました参照表から価格を取り込むことに加え、参照表にもデータを記入します。

 

入力表

 

参照表

 

設定方法

 

作成されたプログラム

Sub 合成()

Dim INS, EN, SBK, I, KEYD, F

Application.ScreenUpdating = False

Set INS = Sheets("Sheet8")  '入力出力シート

EN = INS.Range("$B65536").End(xlUp).Row

If EN < 3 Then Exit Sub

INS.Range("$D3:$D" & EN).ClearContents '出力データクリヤ

Set SBK = Sheets("Sheet9") '参照ブックシート

SBK.Range("$C3:$C65536").ClearContents

For I = 3 To EN

    KEYD = INS.Range("$B" & I).Value

    Set F = SBK.Range("$A:$A").Find(What:=KEYD, LookIn:=xlValues, _

        LookAt:=xlWhole, MatchCase:=False)

    If F Is Nothing Then

      INS.Range("$D" & I).Value = ""     '見つからない

    Else

      INS.Range("$D" & I).Value = SBK.Range("$B" & F.Row).Value

      SBK.Range("$C" & F.Row).Value = SBK.Range("$C" & F.Row).Value & INS.Range("$A" & I).Value & ","

    End If

Application.StatusBar = I & "＜--" & EN

Next I

Application.StatusBar = ""

End Sub

 

赤字部は複数の伝票NOを表示できるよう修正

 

結果　

参照表に参照した伝票NOを記入しました。

 

 

合成縦横

 

出力表に縦キー、横キーを記入しておきます。入力表の縦キー、横キーを見て、出力表に転記します。

 

入力表

 

出力表

 

設定方法

 

結果　

金額も出力するようプログラムを修正しました。

キー重複の場合は合計するようプログラム修正が必要です。

 

 

合成繰返

 

参照表が同一キー複数行ある場合の処理。複数行あってもすべて参照します。

(ここでは合計する)

 

入力表

 

参照表

 

設定方法

 

作成されたプログラム

Sub 合成繰返()

'参照表に同一キーが複数あってもすべて参照する。

Application.ScreenUpdating = False

Set INS = Sheets("Sheet12")  '入力出力シート

EN = INS.Range("$A65536").End(xlUp).Row

If EN < 3 Then Exit Sub

INS.Range("$B$3：$B" & EN).ClearContents '出力データクリヤ

Set SBK = ThisWorkbook.Sheets("Sheet13") '参照ブックシート

'ENC=SBK.RANGE("$A65536").End(xlUp).Row  ’参照最終行

For I = 3 To EN

    KEYD = INS.Range("$A" & I).Value

    ST = 1 '検索開始行

    Do

      If ST = 1 Then

        Set F = SBK.Range("$A:$A").Find(What:=KEYD, LookIn:=xlValues, _

        LookAt:=xlWhole, MatchCase:=True)

       Else

        Set F = SBK.Range("$A:$A").FindNext(After:=F)

      End If

       If F Is Nothing Then  '見つからない

           Exit Do

       ElseIf F.Row < ST Then  '　または　上にもどった

           Exit Do

       Else

'        複数あった場合、合計する例

         INS.Range("$B" & I).Value = INS.Range("$B" & I).Value + SBK.Range("$C" & F.Row).Value

         ST = F.Row + 1 '次に探す先頭行

       End If

     Loop

      Application.StatusBar = I & "＜--" & EN

Next I

Application.StatusBar = ""

End Sub

 

結果　

 

 

合成高速

 

合成と機能は同じですが、参照表が10,000件あっても高速で処理できます。

(MATCH関数を使用)

参照表はキー順に並んでいる必要があります。

 

入力表

 

参照表

 

設定方法

 

結果　

 

 

合成挿入

 

参照した結果、キーが連続して複数行あった場合、入力表に挿入します。

 

入力表

 

参照表

 

設定方法

 

結果　

 

 

合成貼付

 

入力表

 

参照表

 

設定方法

コピーするセル範囲を選択できます。

 

結果　

 

 

 

G.集計する

 

 

集計SUMIF

 

SUMIF関数を使って集計します。

 

入力表

 

集計表

 

設定方法

 

作成されたプログラム

SUB　計算SUMIF

’ＳＵＭＩＦ関数を使って集計

Application.ScreenUpdating = False

SET INS=Sheets("Sheet6")　　’入力出力シート

SET SS=Sheets("Sheet7")　　’入力出力シート

EN = INS.Range("$A65536").End(xlUp).Row

IF ＥＮ<3 THEN EXIT SUB

SET SENR = SS.Range("$B$4").CURRENTREGION '集計範囲の連続セル

SEN = SENR.ROWS.COUNT+SENR.ROW-1 '最終行　を連続範囲よりもとめる　ＳＵＭＩＦを下の行に記入可能

  INS.Range("$B$3" ).Formula = "=SUMIF(Sheet7!$B$4:$B$"&　SEN　&",A3,Sheet7!$D$4:$D$"&　SEN　&")"

  INS.Range("$B$3").COPY

　INS.RANGE("$B$3：$B"&EN).PasteSpecial Paste:=xlFormulas, Operation:=xlNone

　INS.CALCULATE

END SUB

 

結果　

作成された式

=SUMIF(Sheet7!$B$4:$B$13,A3,Sheet7!$D$4:$D$13)

 

 

行集計

 

キーごとの合計を挿入します。

 

入力表

 

設定方法

 

結果　

 

 

 

H.セルを修飾する

     

 

 

書式コピー

 

書式シートよりボディ、最終行の書式をコピーします。

 

入力表

 

書式シート

 

設定方法

 

結果　

 

 

 

I.ブック、データの取り扱い 

 

 

 

ﾌｧｲﾙ一覧

 

ホルダを指定してファイル一覧を作成します。

 

入力表

 

設定方法

 

作成されたプログラム

Sub ファイル一覧()

Set fs = CreateObject("Scripting.FileSystemObject")

Set ous = Sheets("Sheet4")

ous.Range("a4:iv65536").ClearContents

fld = "C:\Users\KANA\d\anki_eitango"

Set F = fs.GetFolder(fld)

Set fc = F.Files  'ファイル

'Set fc = F.SubFolders　’サブホルダ

PU = 4

For Each f1 In fc

   ous.Range("$A" & PU).Value = f1.Name ' 'ファイル名 パス付　f1.Path

   ous.Range("$B" & PU).Value = f1.DateLastModified  '作成日

   ous.Range("$C" & PU).Value = f1.Size  'サイズ

   PU = PU + 1

Next

Set fs = Nothing

End Sub

 

結果　

 

 

ﾌﾞｯｸ読込書込

 

ブックの読込、書込のプログラムを作成します。

 

設定方法

作成するプログラムを選択する。

6つのプログラムが作成できます。

Sub ブック読込書込禁止()

書込み禁止で開く

Sub ブック読込書込可能()

書込み可で開く

Sub ブック選択読込()

ブックを選択して読む

Sub ブック保存()

ブックを名前を付けて保存する

Sub ブックCLOSE()

ブックを閉じる

Sub ブックCLOSE上書保存()

ブックを上書き保存し閉じる

 

 

ﾃｷｽﾄ読込書込

 

テキストを読み込みシートに貼り付け、

シートの内容をテキストに書込するプログラム例を出力します。

 

設定方法

 

作成されたプログラム

Sub テキスト読込()

' A3よりテキストデータを出力する

INF = "C:\Users\KANA\d\anki_eitango\説明.txt"

'SET OUS=WORKBOOKS("一覧.xls").SHEETS("Sheet5")　　’入力出力シート

Set OUS = Sheets("Sheet5")  '入力出力シート

' ＩＮＦ 入力ファイル名  ＯＵＳ 出力シート名

OUS.Range("A3:IV65535").ClearContents  '全消去

OUS.Columns("A:A").NumberFormatLocal = "@"  '文字列書式に変更

Close #1

Open INF For Input As #1

C = 3

Do

 Line Input #1, A

 OUS.Range("A" & C).Value = A

 C = C + 1

Loop Until EOF(1)

Close #1

End Sub

Sub テキスト書込()

' A3よりテキストデータに出力する

OUF = "C:\d\説明TEST.txt"

'SET OUS=WORKBOOKS("一覧.xls").SHEETS("Sheet5")　　’入力出力シート

Set INS = Sheets("Sheet5")  '入力出力シート

Close #1

On Error Resume Next

Kill OUF    '出力ファイルを削除

On Error GoTo 0

Open OUF For Output As #1

en = INS.Range("A65536").End(xlUp).Row

For C = 3 To en

  Print #1, INS.Range("A" & C).Value

Next C

Close #1

End Sub

 

 

 

J.フォームを作成する

 

 

     

ﾌｫｰﾑ入力

 

表の内容をフォームに表示し、フォームで入力した結果を表に貼りつける。

フォームを作成し、すべてのオブジェクトの名称を連番にしておきます。

例　TextBox1　ComboBox2　 TextBox3　ListBox4

 

入力表

選択データを登録する

 

設定方法

 

結果　

 

入力結果が入力シート1行目に記入される

作成したフォームに合わせ、プログラムの修正が必要になりますが、

慣れれば簡単にできます。

修正箇所 本体プログラム

Set DS1 = Sheets("Sheet2").Range("$A$1") '格納セル

Set DS2 = Sheets("Sheet2").Range("$B$1") '格納セル

Set LS2 = Sheets("Sheet2").Range("$B$3").Offset(-1) 

Set DS3 = Sheets("Sheet2").Range("$C$1") '格納セル

Set LS3 = Sheets("Sheet2").Range("$C$3").Offset(-1) 

Set DS4 = Sheets("Sheet2").Range("$D$1") '格納セル

Set DS5 = Sheets("Sheet2").Range("$E$1") '格納セル

 

修正箇所 フォーム内プログラム

Private Sub UserForm_Initialize()

'UserForm表示前自動的に実行　データをセルから読込み

Call TEXTboxINT(Me.TextBox1, DS1)

Call COMBOINT(Me.ComboBox2, DS2, LS2)

Call LISTBOXINT(Me.ListBox3, DS3, LS3)

Call checkboxINT(Me.CheckBox4, DS4)

Call OPTIONINT(Me.OptionButton5, DS5)

End Sub

Private Sub CommandButton1_Click()

'ＯＫ入力で　データをセルに貼付け

'リストにデータを追加

Call TEXTboxen(Me.TextBox1, DS1)

Call COMBOEN(Me.ComboBox2, DS2, LS2)

Call listboxen(Me.ListBox3, DS3, LS3)

Call checkboxen(Me.CheckBox4, DS4)

Call OPTIONen(Me.OptionButton5, DS5)

 CAN = 0 'ok

Unload Me

' hide me

End Sub

 

 

 

K.マクロを実行する

 

 

     

ﾏｸﾛ実行

 

他のブックのマクロ(プログラム)を実行します。

 

設定方法

マクロ(プログラム)の入っているブックを選択し、設定します。

 

作成されたプログラム

次の3つのプログラムが作成されます。

Sub マクロ実行()

マクロを実行する

Sub 実行ブック読込書込禁止()

マクロの入っているブックを開く

Sub 実行ブックCLOSE()

マクロの入っているブックを閉じる

 

ﾓｰﾄﾞ切替

 

プログラムの機能を選択するのに、テキストボックスを使った切り替えボタンを使用します。機能を選択には他にセルで選択、フォームで選択などの方法がありますが、テキストボックスを使うと、どこにでも設置でき、簡単に切り替えできます。

 

入力表

テキストボックスを作成し、名前を付けます。ここではMD。

 

設定方法

テキストボックスを選択し、設定します。

処理名を3つまで記載できます。

 

結果　

テキストボックスをクリックすると、次の処理名が表示されます。

もう一回クリックするともとに戻ります。

 

このテキストボックスの値により、処理内容が変わるようにプログラム作成します。

 

 

Sub 実行()

Dim T

Set T = Sheets("Sheet3").TextBoxes("MD").Characters

Select Case T.Text

 Case "処理１"

'’プログラム1を記入

 Case "処理2"

'’プログラム2を記入

End Select

End Sub

 

 

ﾃﾞｰﾀﾁｪｯｸ

 

表の列、行を削除、追加するとプログラムが動作しなくなります。一方、表が変更できないようにプロテクトすると、分類等の手作業での機能が制限されます。

「データチェック」により表がユーザーにより変更されていないかを事前にチェックします。

 

入力表

設定方法

チェックするセルを選択し、設定します。この例では黄色部を選択。

 

 

作成されたプログラム

Sub データチェック()

Set INS = Sheets("Sheet4")   '入力出力シート

ra = Array("$A$4", "$B$4", "$J$3")

DAT = Array("大分類", "小分類", "当月残高")

For k = LBound(ra) To UBound(ra)

   If Trim(INS.Range(ra(k)).Value) <> DAT(k) Then

      INS.Select 'アクティブワークブックにしておくこと

      INS.Range(ra(k)).Select

      MsgBox (INS.Name & "シートのセル" & INS.Range(ra(k)).Address & " 値「" & Trim(INS.Range(ra(k)).Value) & "」は「" & DAT(k) & "」と異なります　フォーマット異常停止します")

      End

   End If

Next k

End Sub

 

結果　

セル"$A$4", "$B$4", "$J$3"　の値がそれぞれ　"大分類", "小分類", "当月残高"　

でなければ　エラー表示し　プログラムを停止します。

 

 

 

基本編　拡張機能編　HOME