1

我正在尝试创建一个函数,该函数从单元格中获取公式字符串作为参数,并将其包含的所有单元格作为字符串数组返回。

Function GetCells(str As String) As String
    Dim stringArray() As String

    GetCells = stringArray
End Function

我想在一个递归函数中使用它,该函数遍历单元格中的所有链接单元格,并用一些字符串替换单元格名称。这是一段概念代码:

Dim result As String
Dim cell As Range
Dim stringArray() As String
Dim arraySize As Integer

Set stringArray = GetCells("A1 + A2")
arraySize = UBound(stringArray)

For n = 0 To arraySize Step 1
   Set cell = Range(stringArray(n))
   result = Replace(result, stringArray(n), "Some text")
Next

我唯一的解决方案是创建一个状态机并查找字符和整数对,然后根据结果构建数组。有没有更简单的方法可以通过某些功能做到这一点?如果是怎么办?

4

3 回答 3

4

另一种选择是通过“Microsoft VBScript Regular Expressions 5.5”库提供的正则表达式匹配功能。

以下基于正则表达式的函数将字符串公式作为参数,并返回公式中单元格引用的数组。如果没有找到有效的单元格引用,则返回 -1。

  Function GetCellRefs(formulaStr As String) As Variant

      Dim regEx As New VBScript_RegExp_55.RegExp
      Dim matches As Variant, match As Variant
      Dim resArr()
      Dim i As Long

      regEx.pattern = "(\$?[a-z]+\$?\d+\:\$?[a-z]+\$?\d+|\$?[a-z]+\$?\d+)"
      regEx.IgnoreCase = True
      regEx.Global = True

      If regEx.Test(formulaStr) Then
          Set matches = regEx.Execute(formulaStr)
          ReDim resArr(0 To matches.Count - 1)
          i = 0
          For Each match In matches
              resArr(i) = match.Value
              i = i + 1
          Next match
          GetCellRefs = resArr
      Else
          GetCellRefs = Array(-1)
      End If

  End Function

为了使用此功能,您需要通过从 VBA 编辑器中选择工具/参考并在可用参考列表中选中其标题来添加对库的参考。

于 2013-03-06T05:55:55.400 回答
2

我认为您正在寻找的是:

Range("A1").Precedents.Address

( Range.Precedents 属性)

所以,如果 A1 有公式:

=B1+C2-D3

然后Range("A1").Precedents.Address会返回:

$B$1,$C$2,$D$3

如果公式是:

=INDEX($D$1:$D$17,1,1)

然后$D$1:$D$17被退回。

你怎么能用这个?只需将 Range 对象传递给您要评估的范围的函数,然后获取返回的地址列表,将放入另一个范围对象并评估每个单元格。

这是一个示例(例如单元格 A1 和 A2 中有公式):

Option Explicit

Public Function getCells(ByRef r As Excel.Range) As String
    Dim s As String

    getCells = r.Precedents.Address
End Function

Public Sub test()
    Dim rangeString As String
    Dim r As Excel.Range
    Dim cell As Excel.Range

    rangeString = getCells(Sheet1.Range("A1:A2"))
    Set r = Range(rangeString)

    For Each cell In r
        ' do stuff
        Debug.Print "hello: " & cell.Address(0, 0)
    Next cell
End Sub
于 2013-03-06T00:40:05.387 回答
0

在尝试使您在答案中发布的解决方案失败后,我创建了自己的解决方案。
正如我认为创建一个状态机将解决问题,它完美适用于 1x1 单元,这就是我想要的:

源代码

Function isChar(char As String) As Boolean
    Select Case char
        Case "A" To "Z"
            isChar = True
        Case Else
            isChar = False
    End Select
End Function

Function isNumber(char As String, isZero As Boolean) As Boolean
    Select Case char
        Case "0"
            If isZero = True Then
                isNumber = True
            Else
                isNumber = False
            End If
        Case "1" To "9"
            isNumber = True
        Case Else
            isNumber = False
    End Select
End Function

Function GetCells(str As String) As String
    Dim stringArray() As String
    Dim stringSize As Integer 'size of stringArray
    Dim c As Integer 'character number
    Dim chr As String 'current character
    Dim tempcell As String 'suspected cell's temporaly result
    Dim state As Integer 'state machine's state:
    '0 - nothing
    '1 - 1 character eg. A from A1
    '2 - 2 character eg. AG from AG156
    '3 - 3 character eg. AGH from AGH516516
    '4 - characters with number(s) eg. AH15 from AH1569
    '5 - first dollar sing eg. $ from $A$1
    '6 - second sollar sing eg. $A$ from $A$1

    Dim testresult As String

    state = 0
    stringSize = 0

    For c = 0 To Len(str) Step 1
        chr = Mid(str, c + 1, 1)
        Select Case state
            Case 0
                If isChar(chr) Then
                    state = 1
                    tempcell = tempcell & chr
                ElseIf chr = "$" Then
                    state = 5
                    tempcell = tempcell & chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 1
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell & chr
                ElseIf isChar(chr) Then
                    state = 2
                    tempcell = tempcell & chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell & chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 2
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                ElseIf isChar(chr) Then
                    state = 3
                    tempcell = tempcell + chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 3
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                ElseIf chr = "$" Then
                    state = 6
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 4
                If isNumber(chr, True) Then
                    state = 4
                    tempcell = tempcell + chr
                Else
                    state = 0
                    stringSize = stringSize + 1
                    ReDim Preserve stringArray(stringSize)
                    stringArray(stringSize - 1) = tempcell
                    tempcell = ""
                End If
            Case 5
                If isChar(chr) Then
                    state = 1
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case 6
                If isNumber(chr, False) Then
                    state = 4
                    tempcell = tempcell + chr
                Else
                    state = 0
                    tempcell = ""
                End If
            Case Else
                state = 0
                tempcell = ""
        End Select
    Next c
    'GetCells = stringArray
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'This part is only for easily print the string array
    For c = 0 To stringSize Step 1
        testresult = testresult + " | " + stringArray(c)
    Next
    GetCells = testresult
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Function

Sub Main()
Dim s As String
s = "A1+B1+$A1-$B$65"
MsgBox (GetCells(s))

s = "(A5*2+HJ$15)-((F5+F1)-$F11+$PP$659)"
MsgBox (GetCells(s))

'also some crazy input
s = "A$61+$HK2+'p0thecakeisalie/0p'+DDD5+D1-$B$12-LCK$5065"
MsgBox (GetCells(s))

End Sub

测试

我创建了一些测试,以便您可以看到它的实际效果。前两个是模拟日常使用,而第三个是一些疯狂的输入,但算法仍然适用。

情况1

  • 输入:A1+B1+$A1-$B$65
  • 输出:| A1 | B1 | $A1 | $B$65 |

案例2

  • 输入:(A5*2+HJ$15)-((F5+F1)-$F11+$PP$659)
  • 输出:| A5 | HJ$15 | F5 | F1 | $F11 | $PP$659 |

案例3

  • 输入:A$61+$HK2+'p0thecakeisalie/0p'+DDD5+D1-$B$12-LCK$5065
  • 输出:| A$61 | $HK2 | DDD5 | D1 | $B$12 | LCK$5065 |
于 2013-03-08T16:37:27.677 回答