Question

出于文档目的，我想在工作表中编目所有公式。我将如何在VBA中解决这个问题？

显示用于循环工作表中所有单元格的VBA，并仅将公式复制到另一个列表。

Answer 1

Range.SpecialCells method有xlCellTypeFormula作为要查找的xlCellType constants之一。与在Range .HasFormula property内使用Range.Find method或UsedRange property寻找=*相反，这可能会显着减少要循环的细胞。

Option Explicit

Sub enumFormulas()
    Dim f As Long, w As Long, ws As Worksheet
    Dim fws As String, rng As Range, allFormulas As Range
    Dim vPROPs As Variant

    On Error GoTo bm_Safe_Exit
    appTGGL
    fws = "Formulas"

    On Error GoTo bm_New_List_ws
    Set ws = Sheets(fws)
    On Error GoTo bm_Safe_Exit
    For w = 1 To Worksheets.Count
        With Worksheets(w)
            If LCase(.Name) = LCase(fws) Then GoTo bm_Next_ws
            On Error Resume Next
            Set allFormulas = .Cells.SpecialCells(xlCellTypeFormulas, 23)
            On Error GoTo bm_Safe_Exit

            If Not allFormulas Is Nothing Then
                For Each rng In allFormulas
                    With rng
                        vPROPs = Array(.Parent.Name, _
                                       .Address(0, 0), _
                                       .Value, _
                                       .Value2, _
                                       .Text, _
                                       .Formula, _
                                       .FormulaR1C1, _
                                       .NumberFormat)
                    End With
                    With ws.Cells(Rows.Count, 1).End(xlUp) _
                      .Offset(1, 0).Resize(1, UBound(vPROPs))
                        .NumberFormat = "@"
                        .Offset(0, 2).Resize(1, 1).NumberFormat = vPROPs(UBound(vPROPs))
                        .Offset(0, 3).Resize(1, 1).NumberFormat = "General"
                        .Value2 = vPROPs
                    End With
                Next
            End If
bm_Next_ws:
        End With
    Next w

GoTo bm_Safe_Exit
bm_New_List_ws:
    If Err.Number = 9 Then
        vPROPs = Array("Worksheet", ",Address", ".Value", ".Value2", ".Text", ".Formula", ".FormulaR1C1")
        Worksheets.Add after:=Sheets(Sheets.Count)
        With Sheets(Sheets.Count)
            .Name = fws
            .Cells(1, 1).Resize(1, UBound(vPROPs) + 1) = vPROPs
        End With
        Resume
    End If
bm_Safe_Exit:
    appTGGL
End Sub

Sub appTGGL(Optional bTGGL As Boolean = True)
    Application.Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    Application.EnableEvents = bTGGL
    Application.DisplayAlerts = bTGGL
    Application.ScreenUpdating = bTGGL
    Application.Cursor = IIf(bTGGL, xlDefault, xlWait)
End Sub

Range object及其Range.Cells property有许多属性和其他有效信息，用于记录Worksheet object或Worksheets collection。

Answer 2

答案取决于所需的输出类型。

对于初学者，可以通过将所有字段转换为文本格式来公开所有公式。（在文档的副本上试试这个，这样你就不必依赖UNDO命令将东西恢复原状。）

另一种方法是在Excel中创建一个工作表，其中包含三个单独的列中的源工作表名称，单元格地址和公式。

Public Sub ListFormulas()

  Dim sWS As Worksheet
  Dim tWS As Worksheet
  Dim lRow As Long
  Dim aCell As Range

  With ActiveWorkbook
    Set sWS = .Sheets("BiosList 2.16")   'SourceWorksheetName
    Set tWS = .Sheets("Junk")    '*** i.e. where the list will be created  TargetWorksheetName

  End With

  With tWS
    .Range("A1").Value = "Source Worksheet"
    .Range("B1").Value = "Cell Address"
    .Range("C1").Value = "Formula"
  End With

  lRow = 2    '*** Start target list in row 2

  For Each aCell In sWS.UsedRange
    If Left(aCell.Formula, 1) = "=" Then
      With tWS
        .Range("A" & lRow).Value = sWS.Name
        .Range("B" & lRow).Value = aCell.Address
        .Range("C" & lRow).Value = "'" & aCell.Formula
      End With
      lRow = lRow + 1
    End If
  Next aCell
  MsgBox "Done"

End Sub

Answer 3

您只想查看公式而不是结果？

CTRL-`

（键盘上esc键下方的键，1左侧）在工作表中的公式和结果视图之间循环。

从单元格中删除Excel公式

3 个答案: