[[20140423135242]] 『点在するセルに設定された数式の中の参照セルを一』(晴れ晴れ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『点在するセルに設定された数式の中の参照セルを一括で一定の列数ずらしたい』(晴れ晴れ)

こんにちは、ご教示下さい。

シートはSheet(1)、Sheet(2)とあります。

Sheet(2)の
F7:F8,F10,J7:J8,J10,M7:M8,M10,P7:P8,P10,E16:F18,E20:F20,J16:J18,J20,
M16:M18,M20,P16:P18,P20
に入力されている数式ですが

F7→=SUM('Sheet(1)'!V16:X21)
J7→=SUM('Sheet(1)'!AJ16:AL21)
E16→=SUM('Sheet(1)'!Q16)
などなど…となっておりまして

数式の中の参照セルを
F7→=SUM('Sheet(1)'!AJ16:AL21)
J7→=SUM('Sheet(1)'!AX16:AZ21)
E16→=SUM('Sheet(1)'!AE16)
のように列を右に14ずらしたいのですが(内2列は結合セルになっているので13ずらすになるのでしょうか?)
どのようなコードになるのか教えてください。
宜しくお願い致します。

< 使用 アプリ:Excel2003→2010になる予定です、使用 OS:Windows XP→7になる予定です >


 範囲を選択してから実行

 Sub test()
    Dim r As Range
    With CreateObject("VBScript.RegExp")
        .Pattern = "(=SUM\('Sheet\(1\)'!)([A-Z]*\d+(:[A-Z]+\d+)?)\)"
        For Each r In Selection
            If .test(r.Formula) Then
                r.Formula = .Replace(r.Formula, "$1" & Range(.Replace(r.Formula, "$2")) _
                .Offset(, 14).Address(0, 0) & ")")
            End If
        Next
    End With
End Sub
(seiya) 2014/04/23(水) 15:48

(seiya)さん

回答有難うございます。
実行してみたのですが、なんら変化がないのですが・・・
ずらしたいセルを複数選択してから実行ですよね?

(晴れ晴れ) 2014/04/24(木) 09:58


 実際に変更させる数式の入ったセルを選択
 という意味です。
 その数式が入力されていなければ、変化しません。
(seiya) 2014/04/24(木) 10:05

(seiya)さん
おっしゃる事をしているつもりなのですが…

F7→=SUM('Sheet(1)'!V16:X21)
J7→=SUM('Sheet(1)'!AJ16:AL21)
E16→=SUM('Sheet(1)'!Q16)
と設定してあり

F7、J7、E16を選択して実行

F7→=SUM('Sheet(1)'!V16:X21)
J7→=SUM('Sheet(1)'!AJ16:AL21)
E16→=SUM('Sheet(1)'!Q16)

のままなんです…
(晴れ晴れ) 2014/04/24(木) 10:15


 ヘンですねー、こちらでは変換されていますが?
 =SUM('Sheet(1)'!V16:X21) → =SUM('Sheet(1)'!AJ16:AL21)
(seiya) 2014/04/24(木) 11:10

(seiya)さん

新規シートでテストしてみて動作確認後、再度テストしてみたら変換されました!
ありがとうございました。
(晴れ晴れ) 2014/04/24(木) 13:19


(seiya)さん

 Dim buf As String

    buf = Sheets(1).Name

 としてあって、シート名を取り込みたい時は

 .Pattern = "(=SUM\('Sheet\(1\)'!)([A-Z]*\d+(:[A-Z]+\d+)?)\)"

どう変更すればよいでしょうか? 
(晴れ晴れ) 2014/04/24(木) 14:43


 こっちかな?

 Sub test()
    Dim r As Range, buf As String
    buf = Sheets(1).Name
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([\$\(\)\|\^\[\]\*\+\?\.\\])"
        buf = .Replace(buf, "\$1")
        .Pattern = "(=SUM\('?" & buf & "'?!)([A-Z]*\d+(:[A-Z]+\d+)?)\)"
        For Each r In Selection
            If .test(r.Formula) Then
                r.Formula = .Replace(r.Formula, "$1" & Range(.Replace(r.Formula, "$2")) _
                .Offset(, 14).Address(0, 0) & ")")
            End If
        Next
    End With
End Sub
(seiya) 2014/04/24(木) 15:02

ありがとうございます、思うようになりました。

最初のずらす件の方で数式パターンが違うものを見つけてしまいまして
後出しになって申し訳ないのですが、コードの変更箇所を教えていただけますか?

=SUM('Sheet(1)'!FB20:FB21,'Sheet(1)'!FB25:FB30)
(晴れ晴れ) 2014/04/24(木) 17:16


 変更箇所とかそんな簡単なもんじゃないよ?
 =SUM('Sheet(1)'!FB20:FB21,'Sheet(1)'!FB25:FB30,AB1:AC2)
 なんてのもあれば、全部シフトしちゃうよ?

 Sub test()
    Dim r As Range, buf As String, temp As String
    buf = Sheets(2).Name
    With CreateObject("VBScript.RegExp")
        For Each r In Selection
            If r.Formula Like "=SUM(*" & buf & "*" Then
                .Pattern = "([\$\(\)\|\^\[\]\*\+\?\.\\])": .Global = True
                  Do While .test(temp)
                    temp = .Replace(temp, Replace(Range(.Execute(temp)(0)).Offset(, 14).Address, "$", Chr(2)))
                Loop
                r.Formula = Replace(temp, Chr(2), "")
            End If
        Next
    End With
End Sub

(seiya) 2014/04/24(木) 18:24


チェックが甘くて申し訳ないです…
作り直しさせてしまってすみません。

新しいコードですが、下記どのパターンの数式でも数式が消えてしまいます。
=SUM('Sheet(1)'!FB20:FB21,'Sheet(1)'!FB25:FB30)
=SUM('Sheet(1)'!Q16)
=SUM('Sheet(1)'!AJ16:AL21)

(晴れ晴れ) 2014/04/30(水) 11:34


 簡単なサンプルを使った手作業での例ですが

 Book1の A1:A5に =SUM('Sheet1 (1)'!A1:C1) の式が入っていたとします。
 A2:A3の式を D:F列を参照する式に変更したい時

 Sheet1 と Sheet1 (1) を作業グループにして 新しいブック(Book2)にコピー
 A1,A4:A5の式を削除
 Sheet1 (1)でA:C列を挿入
 A1:A5をコピー
 Book1のA1セルから 形式を選択して貼り付け→空白セルを無視する で貼り付け
 Book1のA2セルは =SUM('[Book2]Sheet1 (1)'!D2:F2) の式が入るので「 [Book2] 」を置換で削除

 で、変更できます。
  
(HANA) 2014/04/30(水) 12:07

HANAさん

回答有難う御座います。
セルが点在するので、シートを作成した本人でさえ手作業だとやはり処理漏れセルが起こる為、
引き継ぐ身としましてはコードで処理がすごく助かるのです。
お願いした内容ってすごく難しいのでしょうか…?
(晴れ晴れ) 2014/05/01(木) 16:49


 おっと、こっちでしたね...

 Sub test()
    Dim r As Range, buf As String, temp As String
    buf = Sheets(1).Name
    With CreateObject("VBScript.RegExp")
        For Each r In Selection
            If r.Formula Like "=SUM(*" & buf & "*" Then
                temp = r.Formula
                .Pattern = "\$?[A-Z]+\$?\d+(:\$?[A-Z]+\$?\d+)?": .Global = True
                Do While .test(temp)
                    temp = .Replace(temp, Replace(Range(.Execute(temp)(0)).Offset(, 14).Address, "$", Chr(2)))
                Loop
                r.Formula = Replace(temp, Chr(2), "")
            End If
        Next
    End With
End Sub
(seiya) 2014/05/01(木) 17:11

大変遅くなりすみません、指定した全セルが思うようになりました。
有難うございました。
(晴れ晴れ) 2014/05/13(火) 17:25

(seiya)さん
すみません、せっかく書き直して頂いたコードですが

=SUM('Sheet(1)'!FB20:FB21,'Sheet(1)'!FB25:FB30)
=SUM('Sheet(1)'!FB20:FB21,'Sheet(1)'!FB20:FB21)
                          ↑セル番地が変わってしまうのですが…
(晴れ晴れ) 2014/05/14(水) 12:52


 > : .Global = True
 削除してください。
(seiya) 2014/05/14(水) 13:20

ありがとうございます、出来ました。
(晴れ晴れ) 2014/05/14(水) 16:25

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.