从VBA类型不匹配的范围中删除所有间接函数实例

Question

我需要一些代码帮助来删除INDIRECT公式，并将其替换为间接函数引用的命名范围。代码运行良好，直到它到达一个包含相当长的公式（4000+个字符）的单元格

我在"DirectPart=Evaluate（IndirectPart）"上得到一个类型不匹配

我猜我的公式的长度是个问题，但不知道该怎么办才能解决。

Sub ButtonParseIndirect_Click()
Dim TheFormula As String
Dim IndirectPart As String
Dim DirectPart As String

Range("A1").Activate
Do Until ActiveCell = Range("FF100")
Range("A1:FF100").Find(what:="INDIRECT").Activate
    TheFormula = ActiveCell.Formula
    Do While InStr(TheFormula, "INDIRECT") > 0
        IndirectPart = Mid(TheFormula, InStr(TheFormula, "INDIRECT") + 9)
        IndirectPart = Left(IndirectPart, InStr(IndirectPart, ")") - 1)
        DirectPart = Evaluate(IndirectPart)
        TheFormula = Replace(TheFormula, "INDIRECT(" & IndirectPart & ")", DirectPart)
    Loop
    ActiveCell.Formula = TheFormula
Loop
End Sub

提前感谢！：）

Answer 1

如果INDIRECT后面不是总是一个（而是一个空格！代码行Evaluate(IndirectPart)的开头可能只有一个"（"，结尾没有。

考虑：

? Mid("barghINDIRECT(BL__GH)BLARGH", InStr("barghINDIRECT(BL__GH)BLARGH", "INDIRECT") + 9)
BL__GH)BLARGH
? Left("BL__GH)BLARGH", InStr("BL__GH)BLARGH", ")") - 1)
BL__GH
? Mid("barghINDIRECT ( BL__GH ) BLARGH", InStr("barghINDIRECT(BL__GH)BLARGH", "INDIRECT") + 9)
( BL__GH ) BLARGH

此外，我很想知道你是否认为按照下面的方式编写手机搜索会更慢？

Dim aCell as Range
For each aCell in [A1:FF100]
    if instr(1, aCell.Value, "INDIRECT") then
        ' use your code
        ' refer to aCell instead of Activecell in your code
        ' this will be quicker and
    end if
next aCell

Answer 2

Sub ButtonParseIndirect_Click()
Dim TheFormula As String
Dim IndirectPart As String
Dim DirectPart As String
on error goto 0
Range("A1").Activate
Do Until ActiveCell = Range("FF100")
Range("A1:FF100").Find(what:="INDIRECT").Activate
    TheFormula = ActiveCell.Formula
    Do While InStr(TheFormula, "INDIRECT") > 0
        IndirectPart = Mid(TheFormula, InStr(TheFormula, "INDIRECT") + 9)
        IndirectPart = Left(IndirectPart, InStr(IndirectPart, ")") - 1)
        on error goto skipMe 
        ' if an error occurs ie Evaluate fails, get on with the next cell and leave it as is!
        DirectPart = Evaluate(IndirectPart)
        TheFormula = Replace(TheFormula, "INDIRECT(" & IndirectPart & ")", DirectPart)
    Loop
    ActiveCell.Formula = TheFormula
skipme:
on error goto 0     
Loop
End Sub

Answer 3

以下是工作原理。几乎这是对最初问题的解决方案，因此我还有另一个问题要深入研究。这需要我稍微修改我的excel公式，并添加代码来消除某些地方存在的"间接（连接）"，然后再处理剩余的间接函数。

Sub ButtonParseIndirect_Click()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim RngStr As String
RngStr = "A1:ZZ1000"

'************************************************'
'                PARSE CONCATENATES              '
'************************************************'
    Do Until Range(RngStr).Find(what:="INDIRECT(CONCATENATE") Is Nothing
    On Error GoTo Skip1
    Range(RngStr).Find(what:="INDIRECT(CONCATENATE").Activate
        TheFormula = ActiveCell.Formula
        Do While InStr(TheFormula, "INDIRECT(CONCATENATE") > 0
            ConcatenatePart1 = Mid(TheFormula, InStr(TheFormula, "INDIRECT(CONCATENATE") + 21)
            ConcatenatePart1 = Left(ConcatenatePart1, InStr(ConcatenatePart1, ",") - 1)
            DirectPart = Evaluate(ConcatenatePart1)
            If DirectPart = "" Then GoTo MakeBlank
            If Mid(TheFormula, InStr(TheFormula, ConcatenatePart1 & "," & """") + Len(ConcatenatePart1) + 1) > 0 Then
                ConcatenatePart2 = Mid(TheFormula, InStr(TheFormula, ConcatenatePart1 & ",") + Len(ConcatenatePart1) + 2)
                Else
                On Error GoTo Skip1
                End If
            ConcatenatePart2 = Left(ConcatenatePart2, InStr(ConcatenatePart2, ")") - 2)
            NewPart = DirectPart & ConcatenatePart2
            MaybeNot = Mid(TheFormula, InStr(TheFormula, ConcatenatePart1 & "," & """" & ConcatenatePart2) + Len(ConcatenatePart1) + 2 + Len(ConcatenatePart2), 1)
                If MaybeNot <> """" Then MaybeNot = ""
            OldPart = Mid(TheFormula, InStr(TheFormula, "INDIRECT(CONCATENATE") + 21)
            OldPart = Left(OldPart, InStr(OldPart, ConcatenatePart2 & MaybeNot & ")") + Len(ConcatenatePart2) + Len(MaybeNot) - 1)
            TheFormula = Replace(TheFormula, "INDIRECT(CONCATENATE(" & OldPart & "))", NewPart)
GoTo SkipThisPart1
MakeBlank:
        TheFormula = ""
SkipThisPart1:
        Loop

        If ActiveCell.HasArray = False Or TheFormula = "" Then
            ActiveCell.Formula = TheFormula
            End If
Skip1:
    Loop
'************************************************'
'                  PARSE INDIRECTS               '
'************************************************'
    MsgBox ("Starting section 2, Indirect only removal")
    Range("A1").Activate
    Do Until Range(RngStr).Find(what:="INDIRECT") Is Nothing
    On Error GoTo Skip2
    Range(RngStr).Find(what:="INDIRECT").Activate
        TheFormula = ActiveCell.Formula
        Do While InStr(TheFormula, "INDIRECT") > 0
            IndirectPart = Mid(TheFormula, InStr(TheFormula, "INDIRECT") + 9)
            IndirectPart = Left(IndirectPart, InStr(IndirectPart, ")") - 1)
            On Error GoTo Skipme2
            DirectPart = Evaluate(IndirectPart)
            TheFormula = Replace(TheFormula, "INDIRECT(" & IndirectPart & ")", DirectPart)
Skipme2:
        Loop
        If ActiveCell.HasArray = False Or TheFormula = "" Then
            ActiveCell.Formula = TheFormula
            Else:
            ActiveCell.FormulaArray = TheFormula
            End If
Skip2:
    Loop
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

正如我提到的，这个代码是有效的。我已经证明的问题是公式的长度。真的不知道如何处理，因为长度必须是长度。。。如果不更改数据，就无法更改它。有什么建议吗？