このサイトはCocoonを使っています。現在「ミックスブルー [作者: y.hiroaki氏]」スキンを適用中です(^^)/

Excelブック内全数式を一括取得・貼り付けするVBA汎用ツール

スポンサーリンク

Excelブック内の計算式の設定を保存しておきたいと思ったことはありませんか?

実は、このコロナ禍で在宅勤務をすることになったんです。ところが、勤務先ではテレワークはほんの限られた人だけに許されていて、私のような者は外部へデータを持ち出しすことが一切できないのです

仕方なく紙ベースで資料を持ち出して、自宅PCで手作業でExcelブックを再作成するなどという信じられないことをやらされています

勤務先の最強セキュリティの中で、実は自分のGoogleアカウントでGoogleアプリにアクセスできることがわかりました。Googleスプレッドシートやドキュメントが使えるのです。ただしアップロードはでません!不正操作ではじかれてしまいます!Excelからシートのセルをコピペすることはできますので、計算式のない表だけのシートは作成できます。表の先頭セルに計算式を「Excelからテキストベースでコピーしてスプレッドシートの該当セルに貼り付ける」などという気の遠くなるような作業を手動で行いました(-_-;)

くるみこ
くるみこ

それは困ったね~
まだまだコロナ治まりそうもないから、計算式を何とかする方法を考えようよ!

とういうわけで、考えましたよ!

【この記事でわかること】
VBAでExcelブック内のすべての計算式をシートに書き出します
・シートに書き出しておいた計算式を元の場所に貼り付けます
・こんなツールの使い方、活用法を解説します

スポンサーリンク

Excelブック内のすべての数式設定を取得保存しよう

くるみこ
くるみこ

解決策が見つかったみたいだね! 詳しく教えてね(^^)

まずはVBA処理のロジックをフロー図で検討

・左側が「取得」するフロー
・右側が「再設定貼り付け」するフローです
・別ブックを指定して開き、処理後に閉じる部分はこのフローには入っていません

それぞれ逆のパターンだけど注意点した点は、「再設定貼り付け」では「再計算」を処理前に中止して処理完了後に「再計算」を有効に変更している点です。数式を貼付けている途中で再計算が頻繁に発生するのを抑えるのと、それによる不具合を回避するためです

Excelに設定保存用のシートを用意します

・「Formula」というシートひとつ
・コマンドボタン(ActiveXコントロール)を2つ貼付けします
・シート1行目は「シート名」
・シート2行目に「Range」「Formula」列見出しが配置されます
・シート3行目からが取得した設定データです
面倒な場合はリンクからサンプルファイルをご利用ください
・今回はコマンドボタンのイベントに呼び出しコードを入れます
 ※この部分は後半の部分で解説します

Excelブック内の数式設定を取得・再設定するVBAコードを紹介

・各プロシージャ別にVBAコードを紹介・解説します

Excelブック内のすべての数式設定を取得するVBAコード

「シート名」「設定セル番地」「数式文字列」を取得して、保存シートに書き込むコードです

Option Explicit
'Excelブック内の全数式の設定を取得して書き出す
Sub GetFormulas()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim rng As Range
    Dim rn As Range
    Dim c As Long, r As Long
    Dim selectFileName As String
    'ファイル選択ダイアログを表示
    selectFileName = _
        Application.GetOpenFilename( _
            FileFilter:="Microsoft Excel ブック,*.xls?", _
            Title:="対象ファイルを選択してください", _
            MultiSelect:=False)
    If selectFileName = "False" Then _
                MsgBox ("未選択のため処理を中止します!"): Exit Sub
    With Application
        .ScreenUpdating = False             '画面描画停止
        .Calculation = xlCalculationManual  '計算を手動に
    End With
    Dim tgwb As Workbook
    'ブックを開きオブジェクト変数に入れる
    Set tgwb = Workbooks.Open(Filename:=selectFileName, UpdateLinks:=0)
    ThisWorkbook.Activate   'アクティブを開いたブックから自ブックに戻す
    Set wb = ThisWorkbook   '自ブックをオブジェクト変数にセット
    With wb.Sheets("Formula")   'ActiveSheetでもいいけどあえて指定してる
        .Cells.Clear            'シートをクリア
        .Cells.NumberFormatLocal = "G/標準" '書式設定を標準にする
        On Error Resume Next    '数式がない場合のエラーを無視する
        For Each sh In tgwb.Sheets  '開いたブック内のシート数分のループ
            If sh.Name = "Formula" Then GoTo pass '"Formula"はパスする
            c = c + 1   '書き込み先の列設定用(最初を1にするため)
            .Cells(1, c) = sh.Name          'シート名書き込み
            .Cells(2, c) = "Range"          'レンジアドレス見出し
            .Cells(2, c + 1) = "Formula"    '数式見出し
            'SpecialCellsで数式セルだけをRangeオブジェクトにセット
            Set rng = sh.Cells.SpecialCells(xlCellTypeFormulas)
            r = 2
            For Each rn In rng
                r = r + 1
                .Cells(r, c) = rn.Address      'セルのRangeアドレス
                .Cells(r, c + 1).NumberFormatLocal = "@" '書式を文字列に
                .Cells(r, c + 1) = rn.Formula  '数式
            Next
            c = c + 1   '書き込み先の列インクリメント用
pass:
        Next
    End With
    tgwb.Close (False)  '開いたブックを閉じる
    Set tgwb = Nothing  'オブジェクト解放
    Set wb = Nothing
    Set sh = Nothing
    With Application
        .Calculation = xlCalculationAutomatic '計算を自動に
        .ScreenUpdating = True                '画面描画開始
    End With
    MsgBox "計算式の取得処理を完了しました!"
End Sub

★当初自ブックに対して処理するように書いていましたが、指定した他ブックの数式設定を取得する処理に変更しました(少し書き換えれば自ブックに変更できます)
【コード内にコメントを入れていますので主な部分だけ補足説明します】
・「10~17行目」ファイル選択ダイアログから対象のファイルを選択する
・「18~21行目」画面描画と再計算を停止させています
 (当初フローでは入れていませんでしたが別ブック対応にしたため変更しました)
・「24行目」で選択ファイルを開きオブジェクト変数に入れています
・取得する項目は「シート名」「数式セルの場所」「数式文字列」の3項目です
「38行目」SpecialCells(xlCellTypeFormulas)で数式の設定してあるセルだけ取得して変数に格納するようにしています
・「40~45行目」で取得した情報を保存シートに書き込んでいます

Excelブックに保存設定データで数式を再配置するVBAコード

・動作が重いなどの理由で、数式を値に変換貼り付けしていたブックを元通り復元にします
・【取得】した数式設定(シート名・番地・数式)を使い、再設定するコードです

'保存した数式の設定データを使って再設定する
Sub SetFormulas()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim rng As String
    Dim n As Long
    Dim c As Long, r As Long, i As Long
    Dim selectFileName As String
    'ファイル選択ダイアログを表示
    selectFileName = _
        Application.GetOpenFilename( _
            FileFilter:="Microsoft Excel ブック,*.xls?", _
            Title:="対象ファイルを選択してください", _
            MultiSelect:=False)
    If selectFileName = "False" Then _
                MsgBox ("未選択のため処理を中止します!"): Exit Sub
    With Application
        .ScreenUpdating = False             '画面描画停止
        .Calculation = xlCalculationManual  '計算を手動に
    End With
    Dim tgwb As Workbook
    'ブックを開きオブジェクト変数に入れる
    Set tgwb = Workbooks.Open(Filename:=selectFileName, UpdateLinks:=0)
    ThisWorkbook.Activate   'アクティブを開いたブックから自ブックに戻す
    Set wb = ThisWorkbook   '自ブックをオブジェクト変数にセット
    With wb.Sheets("Formula")
        On Error Resume Next
        For Each sh In tgwb.Sheets  '開いたブック内のシート数分のループ
            If sh.Name = "Formula" Then GoTo pass
            'シート名の設定保存列を検索する
            c = Application.WorksheetFunction.Match(sh.Name, .Rows(1), 0)
            n = .Cells(Rows.Count, c).End(xlUp).Row '設定の最終行
            For r = 3 To n          '設定数分のループ
                rng = .Cells(r, c)  'アドレスを文字列変数に入れる
                sh.Range(rng).Formula = .Cells(r, c + 1).Formula '数式をセット
            Next
pass:
        Next
    End With
    tgwb.Close (False)  '開いたブックを閉じる
    Set tgwb = Nothing  'オブジェクト解放
    Set wb = Nothing
    Set sh = Nothing
    With Application
        .Calculation = xlCalculationAutomatic '計算を自動に
        .ScreenUpdating = True                '画面描画開始
    End With
    MsgBox "計算式の再設定(書き込み)を完了しました!"
End Sub

【コード内にコメントを入れているので参照願います】
・「17~20行目」画面描画と再計算を停止させています
・「31行目」でシート名を検索しての設定保存列を取得しています
・「32~36行目」設定保存列の最終行から設定数分ループさせています
「35行目」で数式を設定セルに書き込んでいます
・「45行目」すべての書き込みが終わった後、「再計算」を自動に変更しています

シートモジュールのイベントに設定したコード

・コマンドボタンから処理コードを呼び出すための設定です
コマンドボタンの位置を制御するためのコードも設定しました

Option Explicit
'取得実行処理呼び出し
Private Sub CommandButton1_Click()
    Call GetFormulas
End Sub
'数式再設定処理呼び出し
Private Sub CommandButton2_Click()
    Call SetFormulas
End Sub
'コマンドボタンの挙動制御
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WinTop As Long
    Dim WinLeft As Long
    '表示されている画面の位置を変数にセット
    WinTop = ActiveWindow.VisibleRange.Top
    WinLeft = ActiveWindow.VisibleRange.Left
    'コマンドボタンの位置を表示画面からの位置に設定
    CommandButton1.Top = WinTop + 70
    CommandButton2.Top = WinTop + 140
    CommandButton1.Left = WinLeft + 165
    CommandButton2.Left = WinLeft + 165
End Sub

・「4行目」Call GetFormulasで「取得実行処理」プロシージャを呼び出しています
・「8行目」Call SetFormulas「数式再設定処理」プロシージャを呼び出しています
「11~22行目」で「コマンドボタン」が追従して動くように設定しています
ただ、「Worksheet_SelectionChange」イベントに設定してますから、例えばスクロール後に「コマンドボタン」が画面から隠れていても、セルをクリックすれば指定位置に現れるようにしています(「Change」イベントに設定すれば、スクロール時に動作しますが頻繁にイベントが発生してしまうためあえて「SelectionChange」イベントにしています

まとめ(おわりに)

まとめと感想など

前回記事で、ExcelVBAで「計算式の一括貼付け」「計算結果を値貼付け」の処理を汎用で使えるように設計してみました。設定を手動で行うのが少し面倒でしたが、今回紹介したこの記事の方法ではそれを全部まとめて処理してしまおうという内容でした
・ただし、計算式を値に変換する処理は入れていませんので使い分けしてください
・設定取得後に値変換するコードを追加すれば出来そうです。次のような感じです
・「44行目」の .Cells(r, c + 1) = rn.Formula ‘数式 の次に
・rn.Value = rn.Value とすれば出来ると思います (動作確認していませんが(^^;)

・今回の目的は、数式を保存するのが目的でしたのでそのような解説になっています
・「数式」の設定を書き出したシートはバックアップとして使えます
・冒頭で紹介した私のような職場の実態がある方は是非使ってみてください!

VBAコードを実行する際は必ずバックアップを取ってから行ってください
・VBAは実行後にファイルを保存してしまうと元に戻すことはできません!
・実行後にファイルを保存せず終了すれば、実行前に戻すことができます!


ブログランキングに参加しています(^^)応援よろしくお願いしますm(_ _)m
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村

Visual Basicランキング

今後の記事について

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
是非!サンプルファイルをダウンロード出来ますのでそのまま使ってみてください(^^)/

【今後の記事内容はどうしようかなぁ・・・】
・実務に役立つものを提供できるよう現在検討中です
・その他雑記的に「小ネタなどいろいろ」・・・・・
・今後の記事にご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください