从封闭的Excel文件中获取公式(而不仅仅是值)

时间:2011-11-01 21:32:47

标签: excel vba xlm

我能够使用广泛使用的GetValues函数从已关闭的工作簿中获取值;它很棒。

但有时我需要从已关闭的工作簿中获取单元格的公式。我尝试修改GetValues以获取单元格公式,但我收到错误。

如何从封闭的excel文件中获取单元格的公式(非简单值)?

With Sheets
  For r = 2 To NewRowQty ' from second row to last row
    For c = 1 To ThisColumnEnd ' out to EndColumn (from import dialogue box)
      ThisCell = Cells(r, c).Address
      ThisValue = GetValue(ThisPath, ThisFile, ThisSheet, ThisCell)
      If ThisValue <> "0" Then
        If c = 3 And r > 2 Then
          Cells(r, c).Formula = GetFormula(ThisPath, ThisFile, ThisSheet, ThisCell)
        Else
          Cells(r, c) = ThisValue
        End If
      End If
    Next c
  Next r
End With

调用这两个函数,GetValue工作正常,GetFormula不会抓取公式。

Private Function GetValue(p, f, s, c)
  'p: path: The drive and path to the closed file (e.g., "d:\files")
  'f: file: The workbook name (e.g., "budget.xls")
  's: sheet: The worksheet name (e.g., "Sheet1")
  'c: cell: The cell reference (e.g., "C4")

  'Retrieves a value from a closed workbook
  Dim arg As String
  'Make sure the file exists
  If Right(p, 1) <> "\" Then p = p & "\"
  If Dir(p & f) = "" Then
    GetValue = "File Not Found"
    Exit Function
  End If
  'Create the argument
  arg = "'" & p & "[" & f & "]" & s & "'!" & _
  Range(c).Range("A1").Address(, , xlR1C1)
  'Execute an XLM macro
  GetValue = ExecuteExcel4Macro(arg)
End Function

Private Function GetFormula(p, f, s, c)
  'p: path: The drive and path to the closed file (e.g., "d:\files")
  'f: file: The workbook name (e.g., "budget.xls")
  's: sheet: The worksheet name (e.g., "Sheet1")
  'c: cell: The cell reference (e.g., "C4")

  'Retrieves a value from a closed workbook
  Dim arg As String
  'Make sure the file exists
  If Right(p, 1) <> "\" Then p = p & "\"
  If Dir(p & f) = "" Then
    GetFormula = "File Not Found"
    Exit Function
  End If
  'Create the argument
  arg = "'" & p & "[" & f & "]" & s & "'!" & _
  Range(c).Range("A1").Address(, , xlR1C1).Formula
  'Execute an XLM macro
  GetFormula = ExecuteExcel4Macro(arg)
End Function

更新:Joel的第一个代码帖子是我最终使用的基础,所以我标记了正确的。这是我使用整行公式的复制粘贴的实际实现。这是最好的,因为我不知道有多少列可能包含值或公式,可能是C或ZZ。

' silent opening of old file:
Application.EnableEvents = False
Set o = GetObject(FileTextBox.Text)
With Sheets
    For r = 2 To NewRowQty ' from second row to last row
        ThisCell = "A" & r
        o.Worksheets(ThisRate).Range(ThisCell).EntireRow.Copy
        Sheets(ThisRate).Range(ThisCell).PasteSpecial xlFormulas
    Next r
End With
' Close external workbook, don't leave open for extended periods
Set o = Nothing
Application.EnableEvents = True

2 个答案:

答案 0 :(得分:3)

为什么这么复杂的代码?您出于某种原因使用的代码是调用Excel 4.0向后兼容模式宏处理器。我无法想象为什么你会这样做。

这是从单元格Sheet1获取公式的简单方法!c:\ tmp \ book.xlsx的A1:

Dim o As Excel.Workbook
Set o = GetObject("c:\tmp\Book.xlsx")
MsgBox o.Worksheets("Sheet1").Cells(1, 1).Formula
Set o = Nothing ' this ensures that the workbook is closed immediately

答案 1 :(得分:1)

如果您坚持运行Excel 4 - 样式宏(1994年已废弃!),您需要使用XLM函数GET.FORMULA来检索公式而不是值,如下所示:< / p>

arg = "GET.FORMULA('" & p & "[" & f & "]" & s & "'!" & _
      Range(c).Range("A1").Address(, , xlR1C1) & ")"

请注意,结果将使用R1C1表示法而不是A1表示法。

转换回A1符号(如果你真的想这样做)留给读者练习。