使用VBAtypes不匹配从范围中删除所有间接函数的实例

我需要一些帮助来删除INDIRECT公式，并将它们replace为间接函数引用的指定范围。 代码工作正常，直到它击中包含一个很长的公式（4000 +字符）

我在“DirectPart =评估（IndirectPart）”中遇到types不匹配

我猜我的公式长度是问题，但不知道该怎么做。

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)那么你的代码行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 

另外，我很想知道你是否认为如下编写单元格search会更慢？

 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

这是什么工作。 几乎。 这是原来的问题的解决scheme，我有另一个潜入其中。 这需要我稍微修改我的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 

正如我所提到的，这个代码有效。 我已经certificate的问题仍然是公式的长度。 真的不知道如何处理这个长度必须是长度。 没有办法改变它，也没有改变数据。 有什么build议么？