如何使用 VBA 输入超过 255 个字符的FormulaArray
在这种情况下,似乎有一个替代的标准公式符合原始FormulaArray 的要求。但是,可能存在没有替代公式的情况。
对于这些情况,我有以下方法使用 VBA 输入超过 255 个字符的FormulaArray。
大多数情况下,FormulaArray 的长度超过 255 个字符是由于它包含的 references 的长度,因为它们可能与长常量数组、具有大名称的外部工作簿有关 (如本例) 或具有大名称的工作表(在本例中也是如此)。该方法包括用较短的字符串替换这些长字符串,但是为了使FormulaArray (替换后) 被接受为FormulaArray,这些较短的字符串也需要代表有效的references .
根据上述情况,至少可能存在三种情况,references 长:
- 长常量数组:在这些情况下使用
Defined Names,如此处所述
https://support.office.com/en-za/article/Guidelines-and-examples-of-array-formulas-7d94a64e-3ff3-4686-9372-ecfd5caa57c7
-
Workbooks 大名和
-
Worksheets 大名
对于情况 2 和 3,同样的方法适用:使用短 references 指向 临时 Worksheet 作为临时替换。
将方法应用于此案例:
原文 FormulaArray:使用变量sFmlArray 保存公式
Dim sFmlArray As String
sFmlArray = "=INDEX('[08 Debt Comparison & Provision Report.xlsx]Details by Bus Area & Location'!AK:AK," & _
"MATCH(1,('[08 Debt Comparison & Provision Report.xlsx]Details by Bus Area & Location'!$A:$A = A" & bVal & ") * " & _
"('[08 Debt Comparison & Provision Report.xlsx]Details by Bus Area & Location'!$B:$B=""Total""),0)) * 1000"
我建议使用变量来保存工作簿和工作表的名称,以避免不得不多次编写它们。
Dim sFmlRng as string
sFmlRng = "'[08 Debt Comparison & Provision Report.xlsx]Details by Bus Area & Location'!"
将FormulaArray中的工作簿和工作表的名称替换为对应的变量:
sFmlAry = "=INDEX(" & sFmlRng & "AK:AK," & _
"MATCH(1,(" & sFmlRng & "$A:$A = A" & bVal & ") * " & _
"(" & sFmlRng & "$B:$B=""Total""),0)) * 1000"
假设我们想在D7:D10 范围内输入这么长的FormulaArray,让我们将它分配给一个变量
Dim rFmlAry as Range
Set rFmlAry = ActiveSheet.Range("D7:D10")
使用下面的函数添加临时工作表。此函数还提供了 临时 reference 用作FormulaArray 中的替换
Function WshTmp_Add(rFmlAry As Range, sFmlRngTmp As String) As Worksheet
sFmlRngTmp = "@Tmp"
With rFmlAry.Worksheet.Parent
On Error Resume Next
.Worksheets(sFmlRngTmp).Delete
On Error GoTo 0
Set WshTmp_Add = .Worksheets.Add(Before:=.Worksheets(1))
End With
WshTmp_Add.Name = sFmlRngTmp
WshTmp_Add.Tab.Color = 255
sFmlRngTmp = "'" & sFmlRngTmp & "'!"
Application.Goto rFmlAry
End Function
将FormulaArray 中的长引用替换为较短的引用,并在rFmlAry 范围内输入临时 FormulaArray
sFmlAryTmp = WorksheetFunction.Substitute(sFmlAry, sFmlRng, sFmlRngTmp)
rFmlAry.FormulaArray = sFmlAryTmp
使用FormulaArray,将临时短的references替换为原来的长的
rFmlAry.Replace What:=sFmlRngTmp, Replacement:=sFmlRng, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
最后删除临时 Worksheet
这是整个过程(作为测试,最后添加了几行来验证结果)
Sub FormulaArray_Over255Chr()
Dim rFmlAry As Range, sFmlAry As String, bVal As Byte
Dim WshTmp As Worksheet, sFmlAryTmp As String
Dim sFmlRng As String, sFmlRngTmp As String
Dim blAppDisplayAlerts As Boolean
blAppDisplayAlerts = Application.DisplayAlerts
Rem Set Ranges & Values
bVal = 5
Set rFmlAry = ActiveSheet.Range("D2:D5")
Rem Define External Reference Variable
sFmlRng = "'[08 Debt Comparison & Provision Report.xlsx]Details by Bus Area & Location'!"
Rem Define FormulaArray (Original) - with References as Variables
sFmlAry = "=INDEX(" & sFmlRng & "AK:AK," & _
"MATCH(1,(" & sFmlRng & "$A:$A = A" & bVal & ") * " & _
"(" & sFmlRng & "$B:$B=""Total""),0)) * 1000"
Rem Set Range to Enter FormulaArray
Set rFmlAry = ActiveSheet.Range("D7:D10")
Rem Add Temporary Worksheet
Application.DisplayAlerts = False
Set WshTmp = WshTmp_Add(rFmlAry, sFmlRngTmp)
Rem Set Temporary FormulaArray - Replace long references
sFmlAryTmp = WorksheetFunction.Substitute(sFmlAry, sFmlRng, sFmlRngTmp)
Rem Enter Temporary FormulaArray
rFmlAry.FormulaArray = sFmlAryTmp
Rem Set FormulaArray (Original) - Replace short references in situ
rFmlAry.Replace What:=sFmlRngTmp, Replacement:=sFmlRng, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Rem Delete Temporary Worksheet
WshTmp.Delete
Application.DisplayAlerts = blAppDisplayAlerts
' ****************************************************************
' Lines for TESTING - Resulting FormulaArray - REMOVED when final
' ****************************************************************
Rem Validate FormulaArray
Debug.Print String(3, vbLf)
Debug.Print "FormulaArray in Range: "
Debug.Print rFmlAry.Cells(1).FormulaArray
Debug.Print "FormulaArray VBA: "
Debug.Print sFmlAry
If rFmlAry.Cells(1).FormulaArray = sFmlAry Then
MsgBox "FormulaArray with +255 entered successfully" & vbLf & _
vbLf & rFmlAry.Cells(1).FormulaArray
Else
MsgBox "Something did not worked!" & vbLf & _
vbLf & "Review formulas printed in the Immediate Window"
SendKeys "^g": Stop
End If
' ****************************************************************
End Sub