コンピューター

Excelのマクロ(VBA)で時間のかかる作業を短時間で2

投稿日:2019年9月6日 更新日:

前回、VBAを使用する準備まで行いましたの実際にVBAを
記述していきます。

目次

実際にVBAを記述する

VBAを記述する画面が表示

前の作業でExcelのメニューに「開発」が追加されています。
それをクリックすると「開発」で使用するリボンが表示されます。
その一番左にある「Visual Basic」をクリックします。

VBAを記述する画面が表示されます。

VBAを記述するためのモジュールを追加する

開いた画面の右上部分にある「VBAProject」の枠内で
右クリックをするとメニューが表示されます。
そこから「挿入」を選択すると、追加できるモジュール
「ユーザフォーム」「標準モジュール」「クラスモジュール」が表示されます。
今回は、「標準モジュール」を選択します。

標準モジュールに「Module1」が追加されVBAを記述する画面が表示されます。

処理を記述する

では実際に処理を記述していきます。
今回やりたいことは、
1.複数のExcelファイルの同一セルに値を挿入する。
2.複数のExcelファイルから、シート名に指定されたセルの情報を取得し、
  集計用エクセルファイルに入力する。
の2つになります。

ではここから実際の処理を記述していきます。
処理を記述するには、サブルーチンと呼ばれるものを作成します。
VBAを記述する画面に「sub 処理1」と記述して「Enter」キーを
押すと下記のように
()~End Subが自動で追記されます。

Sub 処理1()

End Sub

この間に、実際の処理を記述していきます。

1.複数のExcelファイルの同一セルに値を挿入する。

下図のように、すべてのExcelに同じように、赤で囲んだセルの中に
「商品11」「250」を追加します。

Sub 処理1()
    Dim i As Integer
    
    Dim exname  As String      '//書き込むExcelファイルの名前
    Dim wb      As Workbook    '//書き込むExcelファイル
    Dim Sht     As Worksheet   '//書き込むExcelファイルのシート
    
    
    '//Sheet1に記載された分だけExcelファイルを開いて値を入力していく
    '//2行目から最終行まで繰り返し
    For i = 2 To 10
        '//Sheet1のi行目,1列目の値をexnameに入れる
        exname = Worksheets("Sheet1").Cells(i, 1)
        
        '//exNameを開く
        Set wb = Workbooks.Open(exname)
        
        '/指定されたシートのセルに値を入力
        Set Sht = wb.Worksheets("Sheet1")
        Sht.Cells(13, 1) = "商品11" '13行の1列
        Sht.Cells(13, 2) = 250      '13行の2列
        
        '//上書き保存して開いたExcelを閉じる
        wb.Close savechanges:=True
    Next

End Sub

処理の記述自体は、以上です。
実行するには、Sub処理1~End Subの間をクリックした後に「F5」キー
を押します。
記述に問題なければ、処理が実行されます。

今回の処理については、10ファイル程度なのですぐに終わりますが、
数1000ファイルを処理することになると、いつ処理が終わるのか、
どこまで処理が進んでいるのか知りたいと思います。

そういう時、私がよく使用するのは
DoEvents
Debug.Print
の2つのコマンドです。

Sub 処理1()
    Dim i As Integer
    
    Dim exname  As String      '//書き込むExcelファイルの名前
    Dim wb      As Workbook    '//書き込むExcelファイル
    Dim Sht     As Worksheet   '//書き込むExcelファイルのシート
    
    
    '//Sheet1に記載された分だけExcelファイルを開いて値を入力していく
    '//2行目から最終行まで繰り返し
    For i = 2 To 5000
        '//Sheet1のi行目,1列目の値をexnameに入れる
        exname = Worksheets("Sheet1").Cells(i, 1)
        
        '//exNameを開く
        Set wb = Workbooks.Open(exname)
        
        '//指定されたシートのセルに値を入力
        Set Sht = wb.Worksheets("Sheet1")
        Sht.Cells(13, 1) = "商品11" '13行の1列
        Sht.Cells(13, 2) = 250      '13行の2列
        
        '//上書き保存して開いたExcelを閉じる
        wb.Close savechanges:=True
        
        '//DoEvents 関数は、プログラムが占有している制御をオペレーティングシステムに返します。
        DoEvents
        
        '//Debug.Printはイミディエイトウィンドウに指定した内容を表示します。
        Debug.Print i & "/5000 " & Now
    Next

End Sub

この処理を実行すると下記のようにイミディエイトウィンドウに
処理状況が表示されます。
1件処理するのに何秒かかるため、あと何分で処理が終わるというような
予想も出来ます。

最後に、処理を記述したExcel ファイルの保存についてですが、
以前のExcel2003までは、拡張子が「xls」となっていて、VBAを
記述したファイルでもそのままの名前で保存することができました。

ただし現在は、VBAを記述したファイルは拡拡張子を「xlsm」に
変更して保存する必要があります。
もし「xlsx」のまま上書き保存してしまった場合は、記述した内容が
全て消えてしまいます

簡単な内容であれば、また書き直せばいいやと思いますが、
複雑な処理を記述していた場合などは、目も当てられない状況に・・・

この部分は、特に気を付けましょう。
続いて2番目の処理を記述していきます。

2.複数のExcelファイルから、シート名に指定されたセルの情報を
  取得し、集計用エクセルファイルに入力する。

今度は、先ほどとは逆に、処理を記述しているExcelファイル自体に
読み込んだExcel ファイルの指定したセルの情報を入力していきます。

先ほどの処理に関しては、シート名が同じで、ファイル名のみが
違っていたため、簡単に記述することができました。

今回は、
・各ファイルによってシート名が違っている。
 ※ただし、シート名は各様式によって固定のため10種類の名称で判断する。
・各シートによって、読み込むセルの場所が違う。
となっていて、ちょっと面倒です。

Sub 処理2()
    Dim i As Integer
    
    Dim exname  As String       '//読み込むExcelファイルの名前
    Dim wb      As Workbook     '//読み込むExcelファイル
    Dim Sht     As Worksheet    '//読み込むExcelファイルのシート
    Dim Sht2     As Worksheet    '//読み込むExcelファイルのシート
    Dim row     As Integer      '//読み込むセルの行番号
    Dim col     As Integer      '//読み込むセルの列番号
    
    
    'Sheet1に記載された分だけExcelファイルを開いて値を入力していく
    '2行目から最終行まで繰り返し
    For i = 2 To 5000
        'Sheet1のi行目,1列目の値をexnameに入れる
        exname = Worksheets("Sheet1").Cells(i, 1)
        
        'exNameを開く
        Set wb = Workbooks.Open(exname)
        
        'シート名ごとに読み込むセルを変更する
        For Each Sht2 In wb.Worksheets
            Select Case Sht2.Name
            Case "様式1"
               row = 5
               col = 2
               Set Sht = wb.Worksheets(Sht2.Name)
               Exit For
            Case "様式2"
               row = 5
               col = 3
               Set Sht = wb.Worksheets(Sht2.Name)
               Exit For
            Case "様式3"
               row = 4
               col = 3
               Set Sht = wb.Worksheets(Sht2.Name)
               Exit For
            End Select
        
        Next
        '//指定されたセルの値を入力
         Worksheets("Sheet1").Cells(i, 2).Value = Sht.Cells(row, col)
         
         '//保存せずにエクセルを閉じる
         wb.Close savechanges:=False
         
         'DoEvents 関数は、プログラムが占有している制御をオペレーティングシステムに返します。
         DoEvents
         
         'Debug.Printはイミディエイトウィンドウに指定した内容を表示します。
         Debug.Print i & "/5000 " & Now
        
        
    Next

End Sub

シート名は、各様式ごとに違ってくるため、読み込んだExcelファイルの
シート名を取得し、条件に合っていた場合その様式名にあった
行番号、列番号を保存し、その値を取得するという処理を行います。
読み込んだExcelファイルは、保存せずにそのまま閉じます。

以上の内容で、今回の処理を行うことができます。

2つの処理でファイル数は、ちょうど10000ファイルほどあったんですが、
プログラムの記述と合わせて、大体5時間ほどで完了することができました。

手作業で10日くらいかかっていたということなので、
かなり短縮できたんではないかと思います。

-コンピューター

執筆者:


comment

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

関連記事

ウイルス対策ソフト

そろそろウイルス対策ソフトの更新日が近づいてきました。現在使用しているのが「ノートン インターネット セキュリティ」画像のとおり 13日の残り日数となっています。このまま延長してもよかったんですが、一 …

no image

Zoomの背景を【Snap Camera】で変更

テレワークやオンライン飲み会など、会社だけでなく大学の新歓などでもZoomなどのオンライン会議アプリを使うことが増えていますね。   そんな中、Web会議や飲み会で 「顔はいいけど部屋を映したくない」 …

no image

Windows10への無償アップグレードはまだ可能?あと5日でサポート終了

Windows7のサポート終了まで残り日数が僅か5日になりました。 Windows 10へのアップグレードにアップグレードしていない人はいないでしょうか? Windows7のサポート期限は2020年1 …

新PCのRyzen3700Xと旧PCのCori7 8700Kをベンチマークで比較

Ryzen3700XのPCとメインで使っていたCorei7 8700Kをベンチマークソフトで比較してみました。 旧メインPCCPU :Intel Cori7 8700Kグラボ:NVIDIA GeFor …

液晶ディスプレイと無線Lan子機を追加で購入

新しくPCを自作するということで、古いパソコンは処分するつもりでしたが子供が処分するなら欲しいと言ってきたのであげることにしました。 ただキーボードやマウスは余っているんですが、液晶ディスプレイが自分 …