我正在尝试创建一个函数，该函数从单元格中获取公式字符串作为参数，并将其包含的所有单元格作为字符串数组返回。
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
我唯一的解决方案是创建状态机并查找字符和整数对，然后从结果中构建数组。通过某些功能有更简单的方法吗？如果是的话怎么样？
答案 0 :(得分：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编辑器中选择工具/参考并在可用参考列表中选中其标题来添加对库的引用。
答案 1 :(得分：2)
我认为你在寻找的是：
Range("A1").Precedents.Address
所以，如果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
答案 2 :(得分：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
我创建了一些测试，以便您可以看到它的实际效果。前两个是模拟日常使用，而第三个是一些疯狂的输入，但算法仍适用于它。
A1+B1+$A1-$B$65 | A1 | B1 | $A1 | $B$65 | (A5*2+HJ$15)-((F5+F1)-$F11+$PP$659) | A5 | HJ$15 | F5 | F1 | $F11 | $PP$659 | A$61+$HK2+'p0thecakeisalie/0p'+DDD5+D1-$B$12-LCK$5065 | A$61 | $HK2 | DDD5 | D1 | $B$12 | LCK$5065 |