VBAにおける参照元の検索とダイレクトに参照する方法

Question

前提・実現したいこと

VBAでマクロを組んでおります。
実現したいこととしては、O列～最終列まで範囲で参照しているところを、直接的に1:1対応で参照したいと考えております。

ここに質問の内容を詳しく書いてください。

やりたいこととしては、
①O列に@が含まれている数式を検索して、
②そのセルの参照元を検索し、
③まずO列において、１：１対応で参照元から参照先に入れ込み、
④参照先のセルを起点に、最終列まで（O列は固定で、最終列まで）右にコピペする。

これらを実現するようなマクロを実装したいと考えております。

①に関しては、FindNext関数を用いて、以下のように検索しようと考えております。
Sub Find@()
Dim rng As Range, tempRng As Range, searchRng As Range

Application.ScreenUpdating = False
Set searchRng = Range("O:O")
Set rng = searchRng.Find(What:="@", LookIn:=xlFormulas)
Set tempRng = rng
Call ApplyStyle_Timeseries    

End Sub

Sub ApplyStyle_Timeseries()
Do While Not rng Is Nothing
Debug.Print rng.Row
Set rng = searchRng.FindNext(rng)
Range(rng.Address).Select
If IsNumeric(Selection.End(xlToRight).Value) = False Or Selection.End(xlToRight).Value = "" Then
Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
Else
Range(Selection, Selection.End(xlToRight).Offset(0, 0)).Select
End If
Loop
End Sub

より具体的に言うと、

![

こちらの1,2枚目の写真においてO153=@$O$118:@Y@118、P153=@$O$118:@Y@118となっていますが、
最終的にはO153=O118, P153=P118,Q153=Q118……Y153=Y118となるようにしたいと考えています。こちらは一例ですが、シート全体に入っている＠の数式において、このように参照元と１：１対応で参照したいと考えております。

発生している問題・エラーメッセージ

②③を実現するにあたって、ネットで検索して「Precedents」プロパティを用いればよいのかと考えておりますが、実際にどのようにマクロに組み込んだらよいのか分かりかねる状況にあります。全くのVBA初心者ではありますが、何卒アドバイス等頂けますと幸甚でございます。

よろしくお願いいたします。

Answer 1

暗黙的なインターセクション演算子:@ - Office サポート

@が含まれている数式を使ったことがなかったのでいろいろ確認してみました。

@が含まれている数式は、Findメソッドでは見つけることができないようです。
また、セルのFormulaプロパティでも、@が削除された数式が返されるようです。
Formula2プロパティで@が含まれてたままの数式を取得できました。

たぶん、ループでセルのFormula2プロパティを調べて、@が含まれていたら修正するという方法になると思います。

とりあえず、O列の数式を修正するコード例です。

Sub AtMarkDelete()

    Application.ScreenUpdating = False
    
    With ActiveSheet.UsedRange.Columns("O")
        Dim c As Range, s As String
        For Each c In .Cells
            s = c.Formula2
            If s Like "*@*:*" Then '@マークが含まれていたら
                s = Split(s, ":")(0) ':より前を取得
                s = Replace(Replace(s, "$", ""), "@", "") '@と$を削除
                c.Formula2 = s
            End If
        Next
    End With

    Application.ScreenUpdating = True

End Sub

If文の部分は下記でもよさそうです。

            If s Like "*@*" Then
                c.Formula = "=" & c.Precedents.Address(False, False)
            End If

Comments

[yamadpyon]

ご回答ありがとうございます。
後は以下のコードによってO列から最終列の１つ手前のセルまで一律コピペするだけで、自分が実現したいマクロを実装できました！汚いかもしれませんが参考に置いておきます。

Sub CopyPaste()
Application.ScreenUpdating = False
With ActiveSheet.UsedRange.Columns("O")
Dim c As Range
For Each c In .Cells
c.Select
Selection.Copy
If IsNumeric(Selection.End(xlToRight).Formula) = False Or Selection.End(xlToRight).Formula = "" Then
Range(Selection, Selection.End(xlToRight).Offset(0, -1)).Select
Else
Range(Selection, Selection.End(xlToRight).Offset(0, 0)).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Next
End With
End Sub

こちらのコードを使用させていただいて、おかげさまで欲しい機能を実現することができました。本当にありがとうございました。

1点だけ質問させて頂きたいのですが、前者のIF文を使用した際に、

c.Formula2 = s

の部分で「アプリケーション定義またはオブジェクト定義のエラーです」との表示が出るのですが、こちらはどういった原因が考えられるのでしょうか？アウトプット自体はできているので無視して頂いてもかまいません。
どうぞよろしくお願いいたします。