Question

我的最终目标是用VBA用适当的直接单元格引用替换Excel工作表中的大约200,000 =偏移公式。例如，我有= Offset（Sheet1！A1，Sheet2！B3，Sheet2！G5）。在sheet2中的B3包含数字2，在sheet2中的G5包含数字3。偏移量公式将sheet1中的数字拉离A1 2行3列（C3）。工作表中有200,000个这些公式，在上例中，我想使用VBA将每个公式都更改为= Sheet1！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

Answer 1

仅使用最简单的OFFSET公式尝试解决方案。为了覆盖更复杂的偏移量公式，可能需要进行更多调整。

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

由于使用大约1000个偏移量公式测试了代码，因此只需3秒钟。要使用200 K公式，可能需要添加

之类的标准技术

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

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

仅可尝试试用工作簿/工作表和反馈。

编辑：添加基于阵列的解决方案以提高性能，仅在不需要标记错误单元的情况下，使用For Each XVariant in Arr并通过消除Union(ErrRng,...可以使速度更快。更改300 K偏移公式大约需要90秒（计算需要70秒，替换需要20秒）。

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

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

1 个答案: