簡體   English   中英

從單元格中刮除Excel公式

[英]Scrape Excel formulas from cells

出於文檔目的,我要在工作表中對所有公式進行分類。 在VBA中我將如何處理?

顯示用於循環工作表中所有單元格的VBA,並將公式僅復制到另一個列表中。

Range.SpecialCells方法具有xlCellTypeFormula作為要查找的xlCellType常量之一。 與使用Range .HasFormula屬性Range.Find方法UsedRange屬性中查找=*相比,這可能會大大減少要循環的單元格。

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.Cells屬性Range對象具有許多屬性和其他有效信息,可用於記錄Worksheet對象Worksheets集合

答案取決於所需的輸出類型。

對於初學者,可以通過將所有字段轉換為文本格式來公開所有公式。 (在文檔副本上嘗試此操作,這樣就不必依靠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

您只想查看公式而不是結果?

CTRL-` 

(鍵盤上esc鍵下方的鍵,位於1的左側)在工作表中的公式和結果視圖之間循環。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM