提取公式

​Option Explicit'日期：2020-5-15'作者：EXCEL办公实战-小易'功能：提取EXCEl中的所有公式'---------------------------------------------------Sub getAllFormula()    Dim allFormulaRng As Range, fmRng As Range

Dim sht As Worksheet

Dim arFormula(1 To 100000, 1 To 4)  Dim n As Long

For Each sht In ThisWorkbook.Worksheets

On Error Resume Next        '已使用区域中定位公式

Set allFormulaRng = sht.UsedRange.SpecialCells(xlCellTypeFormulas)

If Err = 0 Then

If Not allFormulaRng Is Nothing Then                For Each fmRng In allFormulaRng

n = n + 1

With sht

arFormula(n, 1) = n - 1                     '序号

arFormula(n, 2) = sht.Name                '表名

arFormula(n, 3) = fmRng.Address(0, 0)       '地址

arFormula(n, 4) = fmRng.Formula             '公式

End With

Next

End If

Else            '无公式，打印表名和错误说明

Debug.Print sht.Name & "_" & Err.Description

Err.Clear

End If

Next    '写入结果

With Sheets("公式")

.Cells.Clear

With .Columns("A:F")

.Font.Size = 11

.Font.Name = "Microsoft YaHei UI"      .HorizontalAlignment = xlLeft            .NumberFormatLocal = "@"

End With

.[A1].Resize(1, 4) = Array("序号", "表名", "地址", "公式")

.[A2].Resize(n, 4) = arFormula        .Columns("A:F").AutoFit

End With

End Sub