0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

【Excel VBA】相対参照を含む数式を、参照先セルを変えないままほかのセルにコピペする(複数セルをまとめて処理)ショートカットを作成したい

Last updated at Posted at 2019-12-19

1.この記事について

こんなケースを想定。

・業務効率化したい
・数式をコピペすると参照先が自動的に変化する場合にそれを防ぎたい(特に相対参照と絶対参照が混ざった数式)
・複数セルの数式をまとめてほかのセルに持っていきたい

2.やりたいこと

先日投稿した下記の記事の応用。
【Excel VBA】改行コードなしでエクセルのセル内容をコピーするショートカットの作成 - Qiita

今度は値ではなく数式をショートカット押下いっぱつでコピペできるようにする。

作成のきっかけ

下記のようなやりかたもあるらしい↓
相対参照を含む数式を、参照セルを変えないままコピーする方法 | エクセルスキル向上事典

ただしこのやり方だと置換をする分時間がかかり業務効率は落ちるし、
すべてのケースで使えるわけではないようだ。

今回のコードでその問題点を解決したい。

3.使用したツール・環境

・Office2016

4.作成したコード

  • ※ 20191221追記 ※
  • 数式内に改行コードがある場合にも対応できるようにした。
  • 参照形式がR1C1形式を用いている場合にも対応できるようにした。

'******************************************************************************************
'*関数名    :copyCellFormulaToCB_SupportMultiCells
'*機能      :選択セルの数式をすべてクリップボードにコピー
'*引数(1)   :無し
'******************************************************************************************
Public Sub copyCellFormulaToCB_SupportMultiCells()
    
    '定数
    Const FUNC_NAME As String = "copyCellFormulaToCB_SupportMultiCells"
    
    '変数
    Dim tempStr As String
    Dim rowCnt As Long
    Dim colCnt As Long
    Dim is_A1_ReferenceStyle As Boolean
    
    On Error GoTo ErrorHandler
    '---以下に処理を記述---
    
    '参照形式がA1形式ならTRUEとなるフラグ
    is_A1_ReferenceStyle = (Application.ReferenceStyle = xlA1)
    
    '選択範囲の数式を取得
    For rowCnt = 1 To Selection.Rows.Count
        For colCnt = 1 To Selection.Columns.Count
            '数式をコピー(数式内の改行コードは予め除去しておく)
            '※ 参照形式ごとに取得メソッドが異なる
            If is_A1_ReferenceStyle Then
                tempStr = tempStr & Replace(Selection(rowCnt, colCnt).Formula, vbLf, "")
            Else
                tempStr = tempStr & Replace(Selection(rowCnt, colCnt).FormulaR1C1, vbLf, "")
            End If
            '最終列でなければ列のセパレータを付与
            If colCnt <> Selection.Columns.Count Then
                tempStr = tempStr & vbTab
            End If
        Next colCnt
        '最終行でなければ行のセパレータを付与
        If rowCnt <> Selection.Rows.Count Then
            tempStr = tempStr & vbLf
        End If
    Next rowCnt

    'クリップボードに文字列を格納
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .Text = tempStr
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With

ExitHandler:

    Exit Sub
    
ErrorHandler:

    MsgBox "エラーが発生しましたので終了します" & _
           vbLf & _
           "関数名:" & FUNC_NAME & _
           vbLf & _
           "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
        
    GoTo ExitHandler
        
End Sub

5.解説

上記関数をALT + F8でショートカットに割り当てて、
選択範囲に対して使えばコピペできる。

セパレータについて

複数セルの値をクリップボードに張り付ける場合、
行の場合は改行を、列の場合はタブを用いれば別々のセルに値を格納できるので
セパレータとして用いることが可能。

6.終わりに

なにか補足がありましたらコメントください。

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?