将Excel公式字符串解析为VBA

时间:2018-11-14 12:43:25

标签: excel vba parsing

对于给定的Excel函数(例如VLOOKUP),我需要将单元格的公式字符串解析为:

  • preFunctionStr = VLOOKUP函数前面的字符串
  • ExcelFn =“ VLOOKUP”
  • Arguments = VLOOKUP函数内的所有参数的集合(它们本身可能包含函数)
  • postFunctionStr =公式字符串中最后一个“)”之后的字符串

我希望这样做的主要原因是能够转换Excel公式而不更改其答案。例如,将SUMIF转换为SUMIFS,并将VLOOKUP转换为INDEXMATCH的组合。

在我的示例中,我所在的单元格包含公式=A4+VLOOKUP(2,$E$4:$F$8,MATCH("Value(1)",$E$4:$F$4,0),0) + 2000,需要将其解析为上述组件。

尽管我可以在解析Excel公式时找到很多资料,但找不到将其分解为这些组件的资料。

1 个答案:

答案 0 :(得分:0)

在我的解决方案中,我创建了一个Class module,其属性需要将公式字符串拆分为ExcelFormulaParser

Option Explicit

Public ExcelFn As String
Public Arguments As New Collection
Public preFunctionStr As String
Public postFunctionStr As String

Sub SetMeUp(formulaStr As String, FormulaToParse As String)

    Dim FormulaStartPos As Integer
    Dim OpenBracketCounter As Integer
    Dim OpenBracketCount As Integer
    Dim ClosedBracketCount As Integer
    Dim WithinQuote As Boolean
        ' whether we are within quotation marks
    Dim i As Integer

    Dim strChr As String
    Dim Arg_i As String
    Dim Arg As String

    Me.ExcelFn = FormulaToParse

    FormulaStartPos = InStr(1, formulaStr, FormulaToParse)

    Me.preFunctionStr = Mid(formulaStr, 1, FormulaStartPos - 1)
    formulaStr = Mid(formulaStr, FormulaStartPos + Len(FormulaToParse), Len(formulaStr) - Len(FormulaToParse))

    If Left(formulaStr, 1) = "(" Then
        OpenBracketCounter = 1
        formulaStr = Mid(formulaStr, 2, Len(formulaStr) - 1)
    Else
        MsgBox ("Not the full FormulaToParse")
        End
    End If

    i = 0
    Arg_i = ""
    Do While OpenBracketCounter > 0
        i = i + 1
        strChr = Left(formulaStr, 1)
        If Len(formulaStr) > 0 Then
            formulaStr = Right(formulaStr, Len(formulaStr) - 1)
        End If

        If strChr = Chr(34) Then
            WithinQuote = Not (WithinQuote) ' toggle WithinQuote on or off
            ' don't count brackets within quotation marks
        ElseIf strChr = "(" And WithinQuote = False Then
            OpenBracketCounter = OpenBracketCounter + 1
        ElseIf strChr = ")" And WithinQuote = False Then
            OpenBracketCounter = OpenBracketCounter - 1
        End If

        If OpenBracketCounter = 1 And strChr = "," Then
            Arg = Arg_i
            Me.Arguments.Add Arg
            Arg_i = ""
        ElseIf OpenBracketCounter = 0 Then
            Arg = Arg_i
            Me.Arguments.Add Arg
            Arg_i = ""
            Me.postFunctionStr = formulaStr
        Else
            Arg_i = Arg_i & strChr
        End If
    Loop

End Sub

为了提供有关如何调用和使用Class module的示例,我在同一VBA项目中创建了以下模块:

Sub TestFormulaParser()

    Dim ParsedForm As ExcelFormulaParser
    Set ParsedForm = New ExcelFormulaParser
    Dim StrToParse As String
    StrToParse = ActiveCell.Formula
        ' formula contains:
        '' =A4+VLOOKUP(2,$E$4:$F$8,MATCH("Value(1)",$E$4:$F$4,0),0) + 2000
    Call ParsedForm.SetMeUp(StrToParse, "VLOOKUP")

    preFunctionStr = ParsedForm.preFunctionStr
        ' returns the prefunction string i.e. =A4+
    ExcelFn = ParsedForm.ExcelFn
        ' returns the excel function we parsed i.e. VLOOKUP
    Arg1 = ParsedForm.Arguments(1)
        ' returns the first argument of the VLOOKUP function i.e. 2
    Arg2 = ParsedForm.Arguments(2)
        ' returns the second argument of the VLOOKUP function i.e. $E$4:$F$8
    Arg3 = ParsedForm.Arguments(3)
        ' returns the third argument of the VLOOKUP function i.e. MATCH("Value(1)",$E$4:$F$4,0)
    Arg4 = ParsedForm.Arguments(4)
        ' returns the fourth argument of the VLOOKUP function i.e. 0
    postFunctionStr = ParsedForm.postFunctionStr
        ' returns the post function string i.e.  + 2000

End Sub