Excel 如何在VBA中用直接单元格引用替换所有偏移公式？

我的最终目标是用VBA的适当直接单元格引用替换Excel工作表中的大约200000=偏移公式。例如，我有=偏移量（Sheet1！A1、Sheet2！B3、Sheet2！G5）。表2中的B3包含数字2，表2中的G5包含数字3。偏移公式会将sheet1中的数字从A1中拉出2行3列（C3）。表中有200000个公式，我想使用VBA将每个公式更改为=表1！上述示例中的C3。很明显，每个直接单元格引用都是不同的-它们并不都是C3

我现在有下面的代码，但它替换为硬编码的单元号，我想将其更改为动态的

我的代码如下：

Sub FindReplaceAll()

Dim sht As Worksheet
Dim cell As Range
Dim fnd As Variant
Dim rplc As Variant

fnd = "Offset*"
rplc = "Sheet1!C3"

For Each sht In ActiveWorkbook.Worksheets
    sht.Cells.Replace what:=fnd, Replacement:=rplc, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Next sht

End Sub

---

仅使用最简单的

偏移量
公式尝试该解决方案。对于转换更复杂的偏移公式，可能需要进行更多调整

Option Explicit
Sub test()
Dim Xformula As String, Yformula As String
Dim Xref As String, XRow As String, XCol As String
Dim YRow As Long, YCol As Long
Dim ZRow As Long, ZCol As Long
Dim Zsht As String, ZColStr As String
Dim Ws As Worksheet, Cel As Range
Dim tm As Double, Cnt As Long
tm = Timer

Set Ws = ThisWorkbook.ActiveSheet
    Cnt = 0
    For Each Cel In Ws.UsedRange.Cells
    If Mid(Cel.Formula, 2, 6) = "OFFSET" Then
    On Error Resume Next
    Xformula = Cel.Formula
    Xformula = Replace(Xformula, "=OFFSET(", "")
    Xformula = Left(Xformula, Len(Xformula) - 1)
    Xref = Split(Xformula, ",")(0)
    'Debug.Print Xref, Xformula, Cel.Address
    XRow = Split(Xformula, ",")(1)
    XCol = Split(Xformula, ",")(2)
    YRow = Evaluate(XRow)
    YCol = Evaluate(XCol)
        If InStr(1, Xref, "!") > 0 Then
        Zsht = Split(Xref, "!")(0) & "!"
        Else
        Zsht = ""
        End If
    ZRow = Range(Xref).Row + YRow
    ZCol = Range(Xref).Column + YCol
    ZColStr = Split(Cells(1, ZCol).Address, "$")(1)
    Zsht = "=" & Zsht & ZColStr & ZRow
        'The cells contain #REF or could not be converted would me marked Red 
        If Err <> 0 Then
        Cel.Interior.Color = vbRed
        Err.Clear
        On Error GoTo 0
        Else
        Cel.Formula = Zsht
        Cnt = Cnt + 1
        End If
    End If
    Next
 Debug.Print Timer - tm & " Seconds taken to convert " & Cnt & " formulas "
End Sub

但由于我个人并不喜欢它，另一个选择是调整代码，使其仅在选定范围内工作，并一次在工作表中选择一个有限范围并执行

只能试用工作簿/工作表和反馈

编辑：添加基于阵列的解决方案以实现更快的性能，通过在Arr中为每个XVariant使用
，并通过消除
联合（ErrRng，
，只有在不需要标记错误单元格的情况下才可以实现更快的性能。大约需要90秒（70秒计算，20秒替换）更改300 K偏移公式

Option Explicit
Sub test()
Dim Xformula As String, Yformula As String
Dim Xref As String, XRow As String, XCol As String
Dim YRow As Long, YCol As Long
Dim ZRow As Long, ZCol As Long
Dim Zsht As String, ZColStr As String
Dim Ws As Worksheet, ErrRng As Range, Xcel As Variant
Dim tm As Double, Cnt As Long, Arr As Variant
Dim Rw As Long, Col As Long, RngRowOffset As Long, RngColOffset As Long
tm = Timer
Set Ws = ThisWorkbook.ActiveSheet
    Cnt = 0
    Arr = Ws.UsedRange.Formula
    RngRowOffset = Ws.UsedRange(1, 1).Row - 1
    RngColOffset = Ws.UsedRange(1, 1).Column - 1
    'Debug.Print RngRowOffset, RngColOffset
    For Rw = 1 To UBound(Arr, 1)
    For Col = 1 To UBound(Arr, 2)
    Xcel = Arr(Rw, Col)
    If Mid(Xcel, 2, 6) = "OFFSET" Then
    On Error Resume Next
    Xformula = Xcel
    Xformula = Replace(Xformula, "=OFFSET(", "")
    Xformula = Left(Xformula, Len(Xformula) - 1)
    Xref = Split(Xformula, ",")(0)
    'Debug.Print Xref, Xformula, Cel.Address
    XRow = Split(Xformula, ",")(1)
    XCol = Split(Xformula, ",")(2)
    YRow = Evaluate(XRow)
    YCol = Evaluate(XCol)
        If InStr(1, Xref, "!") > 0 Then
        Zsht = Split(Xref, "!")(0) & "!"
        Else
        Zsht = ""
        End If
    ZRow = Range(Xref).Row + YRow
    ZCol = Range(Xref).Column + YCol
    ZColStr = Split(Cells(1, ZCol).Address, "$")(1)
    Zsht = "=" & Zsht & ZColStr & ZRow
        'The cells containg #REF or could not be converted would me marked Red
        If Err <> 0 Then
            If ErrRng Is Nothing Then
            Set ErrRng = Cells(Rw + RngRowOffset, Col + RngColOffset)
            Else
            Set ErrRng = Union(ErrRng, Cells(Rw + RngRowOffset, Col + RngColOffset))
            End If
        Err.Clear
        On Error GoTo 0
        Else
        Arr(Rw, Col) = Zsht
        Cnt = Cnt + 1
        End If
    End If
    Next
    Next
Debug.Print Timer - tm & " Seconds taken to Calculate " & Cnt & " formulas "
Ws.UsedRange.Formula = Arr
Debug.Print Timer - tm & " Seconds taken to Repalce formulas "
ErrRng.Interior.Color = vbRed
Debug.Print Timer - tm & " Seconds taken to mark error cells "
End Sub

选项显式
子测试（）
尺寸X公式作为字符串，Y公式作为字符串
将外部参照标注为字符串、将XRow标注为字符串、将XCol标注为字符串
我的头发和你的一样长，你的头发和你的一样长
变暗ZRow为长，ZCol为长
Dim Zsht作为字符串，ZColStr作为字符串
将Ws作为工作表，将ErrRng作为范围，将Xcel作为变量
Dim tm为双色，Cnt为长形，Arr为变体
变暗Rw为长，Col为长，RngRowOffset为长，RngColOffset为长
tm=计时器
设置Ws=ThisWorkbook.ActiveSheet
Cnt=0
Arr=Ws.UsedRange.Formula
RngRowOffset=Ws.UsedRange（1，1）.Row-1
RngColOffset=Ws.UsedRange（1，1）。列-1
'Debug.Print RngRowOffset，RngColOffset
对于Rw=1至UBound（Arr，1）
对于Col=1至UBound（Arr，2）
Xcel=Arr（Rw，Col）
如果Mid（Xcel，2，6）=“偏移”，则
出错时继续下一步
Xformula=Xcel
Xformula=替换（Xformula，“=偏移量（“，”）
Xformula=左（Xformula，Len（Xformula）-1）
外部参照=拆分（X公式，“，”）（0）
'Debug.Print外部参照，Xformula，Cel.Address
X行=拆分（X公式，“，”）（1）
XCol=Split（Xformula，“，”）（2）
YRow=评估（X行）
YCol=评估（XCol）
如果InStr（1，外部参照“！”）大于0，则
Zsht=Split（外部参照“！”）（0）和“！”
其他的
Zsht=“”
如果结束
ZRow=范围（外部参照）。行+Y轴
ZCol=范围（外部参照）。列+YCol
ZColStr=Split（单元格（1，ZCol）.Address，“$”（1）
Zsht=“=”&Zsht&ZColStr&ZRow
“包含#REF或无法转换的单元格将标记为红色
如果错误为0，则
如果错误不算什么，那么
设置ErrRng=单元格（Rw+RngRowOffset，Col+RngColOffset）
其他的
Set ErrRng=Union（ErrRng，单元格（Rw+rngrowtoffset，Col+RngColOffset））
如果结束
呃，明白了
错误转到0
其他的
Arr（Rw，Col）=Zsht
Cnt=Cnt+1
如果结束
如果结束
下一个
下一个
Debug.Print Timer-tm&“计算所需的秒数”&Cnt&“公式”
Ws.UsedRange.Formula=Arr
Debug.Print Timer-tm&“重新计算公式所需的秒数”
ErrRng.Interior.Color=vbRed
Debug.Print Timer-tm&“标记错误单元格所用的秒数”
端接头
我认为您需要您的代码来识别包含偏移量的单元格，逐个迭代这些单元格，并为每个单元格确定偏移量的确切目标，进行适当的更改。我将从编写一个函数开始，该函数可以在单个单元格中修复公式。似乎可行，但不可行您可以使用
Ws.UsedRange.SpecialCells（xlCellTypeFormulas）.Cells
更改
Ws.UsedRange.Cells
，这将限制仅包含公式的单元格上的循环。我认为这将花费更少的时间：）@Mikku谢谢你的建议。我对在大文件中使用
特殊单元格有点担心，通常不使用它。（可能是excel较低版本中的Microsoft错误，取决于范围对象中的区域）…可以查看我的问题和答案。如果您有关于该主题的任何信息，请添加。根据我的经验，读取此类大文件中的值的时间可以忽略不计。答案经过编辑并添加了一些更快的解决方案。请提供反馈。
Option Explicit
Sub test()
Dim Xformula As String, Yformula As String
Dim Xref As String, XRow As String, XCol As String
Dim YRow As Long, YCol As Long
Dim ZRow As Long, ZCol As Long
Dim Zsht As String, ZColStr As String
Dim Ws As Worksheet, ErrRng As Range, Xcel As Variant
Dim tm As Double, Cnt As Long, Arr As Variant
Dim Rw As Long, Col As Long, RngRowOffset As Long, RngColOffset As Long
tm = Timer
Set Ws = ThisWorkbook.ActiveSheet
    Cnt = 0
    Arr = Ws.UsedRange.Formula
    RngRowOffset = Ws.UsedRange(1, 1).Row - 1
    RngColOffset = Ws.UsedRange(1, 1).Column - 1
    'Debug.Print RngRowOffset, RngColOffset
    For Rw = 1 To UBound(Arr, 1)
    For Col = 1 To UBound(Arr, 2)
    Xcel = Arr(Rw, Col)
    If Mid(Xcel, 2, 6) = "OFFSET" Then
    On Error Resume Next
    Xformula = Xcel
    Xformula = Replace(Xformula, "=OFFSET(", "")
    Xformula = Left(Xformula, Len(Xformula) - 1)
    Xref = Split(Xformula, ",")(0)
    'Debug.Print Xref, Xformula, Cel.Address
    XRow = Split(Xformula, ",")(1)
    XCol = Split(Xformula, ",")(2)
    YRow = Evaluate(XRow)
    YCol = Evaluate(XCol)
        If InStr(1, Xref, "!") > 0 Then
        Zsht = Split(Xref, "!")(0) & "!"
        Else
        Zsht = ""
        End If
    ZRow = Range(Xref).Row + YRow
    ZCol = Range(Xref).Column + YCol
    ZColStr = Split(Cells(1, ZCol).Address, "$")(1)
    Zsht = "=" & Zsht & ZColStr & ZRow
        'The cells containg #REF or could not be converted would me marked Red
        If Err <> 0 Then
            If ErrRng Is Nothing Then
            Set ErrRng = Cells(Rw + RngRowOffset, Col + RngColOffset)
            Else
            Set ErrRng = Union(ErrRng, Cells(Rw + RngRowOffset, Col + RngColOffset))
            End If
        Err.Clear
        On Error GoTo 0
        Else
        Arr(Rw, Col) = Zsht
        Cnt = Cnt + 1
        End If
    End If
    Next
    Next
Debug.Print Timer - tm & " Seconds taken to Calculate " & Cnt & " formulas "
Ws.UsedRange.Formula = Arr
Debug.Print Timer - tm & " Seconds taken to Repalce formulas "
ErrRng.Interior.Color = vbRed
Debug.Print Timer - tm & " Seconds taken to mark error cells "
End Sub