Получить формулы из закрытого файла Excel (а не только значения) - PullRequest
2 голосов
/ 02 ноября 2011

Я могу получить значения из закрытой рабочей книги с помощью широко распространенной функции 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

Обновление: первая запись кода Джоэла была основой того, что я в итоге использовал, поэтому я отметил это правильно. Вот моя фактическая реализация, использующая вставку копий целых формул строк. Это лучше, потому что я не знаю, сколько столбцов может содержать значения или формулы, может быть 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 ]

3 голосов
/ 02 ноября 2011

Почему такой запутанный код?Код, который вы используете, по какой-то причине вызывает макропроцессор режима обратной совместимости Excel 4.0.Я не могу представить, почему вы это сделали.

Вот простой способ получить формулу из ячейки Sheet1! A1 из c: \ tmp \ book.xlsx:

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 голос
/ 02 ноября 2011

Если вы настаиваете на запуске макросов в стиле Excel 4 (устарел в 1994 году!), Вам нужно использовать функцию XLM GET.FORMULA для получения формулы вместо значения следующим образом:

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

Обратите внимание, что результат будет иметь формулы, использующие нотацию R1C1 вместо нотации A1.

Преобразование обратно в нотацию A1 (если вы действительно хотите это сделать) оставлено читателю в качестве упражнения.

...