Как заменить функцию в Excel - PullRequest
0 голосов
/ 14 мая 2019

У меня огромный файл Excel с кучей формул. В ячейках есть куча ссылок на старую функцию funcA, которая будет принимать 1 параметр. В параметр также могут быть встроены другие функции, или другое значение ячейки, или формула. вот так

=C1+C2+funcA(C3)/2 
=funcA(C4+AnotherFun(B1))

Теперь мне нужно поменять все funcA на funcB. Как бы то ни было, funcB принимает два параметра. Мне нужен исходный пункт из funcA в качестве 1-го параметра для funcB, а второй - 0. Поэтому после замены он будет выглядеть так

=C1+C2+funcB(C3,0)/2 
=funcB(C4+AnotherFun(B1),0)

Когда я пытаюсь сделать замену, funcA -> funcB excel отказывается, так как для funcB нужны два параметра. Также мне все еще нужно подумать о том, как добавить ', 0' в вызов функции. Я думаю о совпадении с RegEx, но, похоже, Excel не поддерживает это.

Что я могу сделать?

1 Ответ

1 голос
/ 14 мая 2019
Option Explicit

Sub ReplaceFunction()

    Dim ufr As Range, ufrng As Range
    Dim b As Long, i As Long, x As Long, f As String
    Dim oldf As String, newf As String, p As String

    oldf = "funcA("
    newf = "funcB("
    p = ", 0)"

    On Error Resume Next
    Set ufrng = Worksheets("sheet3").Cells.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If Not ufrng Is Nothing Then

        For Each ufr In ufrng

            f = ufr.Formula
            b = 0
            x = InStr(1, f, oldf, vbTextCompare)

            If x > 0 Then

                For i = x + Len(oldf) To Len(f)
                    'are there nested functions?
                    If Mid(f, i, 1) = ")" Then
                        b = b - 1
                    ElseIf Mid(f, i, 1) = "(" Then
                        b = b + 1
                    End If
                    'ending bracket for funcA
                    If b = -1 Then
                        'add parameter
                        f = Application.Replace(f, i, 1, p)
                        'change function
                        f = Replace(expression:=f, Find:=oldf, Replace:=newf, compare:=vbTextCompare)
                        'no reason to continue
                        Exit For
                    End If
                Next i

                'change formula
                ufr.Formula = f

            End If
        Next ufr

    End If

End Sub


Function funcA(i As Integer)

    funcA = i

End Function

Function funcB(i As Integer, j As Integer)

    funcB = i * j

End Function

Function AnotherFunc(i As Integer)

    AnotherFunc = i

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...