如何查找工作簿中的数组公式，并进行统计和罗列

作者：绿色风分类：时间：2022-08-18 浏览：108

楼主
xmyjk

Q:在一个不确定工作表个数的工作簿中，有N个不确定位置的数组公式，如何查找全部的数组公式，并将结果（工作表名称、单元格地址，公式），
放在新增工作表的单元格上A、B列中。

A:以下代码支持判断不连续的数字公式，就是不靠在一块的那种。连续的数组公式看进阶。

Sub 宏1()
Dim rng As Range, rnga As Range, arr(), n&, sh As Worksheet
For Each sh In Sheets
Set rng = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
For Each rnga In rng.Areas
If rnga.HasArray Then
n = n + 1
ReDim Preserve arr(1 To 2, 1 To n)
arr(1, n) = sh.Name & "表中单元格" & rnga.Address(0, 0)
arr(2, n) = Split(rnga.FormulaArray, "=")(1)
End If
Next
Next
Set sh = Worksheets.Add
sh.Name = "统计结果"
sh.[a1].Resize(UBound(arr, 2), UBound(arr, 1)) = Application.Transpose(arr)
sh.Columns("a:b").AutoFit
End Sub

进阶：以下代码，支持列出所有表的数组和非数组公式，且即使公式靠一块也没问题。

Sub Test2()
Application.ScreenUpdating = False
Dim Rng As Range, r As Range, d, sh As Worksheet
Set d = CreateObject("scripting.dictionary")
On Error Resume Next
For Each sh In Sheets
If sh.Name <> "想法" Then
On Error Resume Next
Set r = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
If Not r Is Nothing Then
For Each Rng In r
If Rng.HasArray Then
d(sh.Name & "表中" & Rng.CurrentArray.Address(0, 0) & "有数组公式" & Rng.FormulaArray) = ""
Else
d(sh.Name & "表中" & Rng.Address(0, 0) & "有公式" & Rng.Formula) = ""
End If
Next
End If
End If
Set r = Nothing: Set Rng = Nothing
Next
Application.ScreenUpdating = True
Worksheets("想法").Select
Worksheets("想法").UsedRange.Clear
[A1].Resize(d.Count, 1) = Application.Transpose(d.KEYS)
End Sub

统计并找出数组公式.rar

进阶.rar

2楼
chenlifeng

是个值得研究的小问题，可惜我不太会。如果有答案了再回复。

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表