Получить формулы из закрытого файла Excel (не только значения)
Я могу получить значения из закрытой рабочей книги с помощью широко распространенной функции 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 ответа
Почему такой запутанный код? Код, который вы используете, по какой-то причине вызывает макропроцессор режима обратной совместимости 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
Если вы настаиваете на запуске Excel 4
- стиль макросов (устарел в 1994 году!), вам нужно использовать XLM
функция GET.FORMULA
получить формулу вместо значения следующим образом:
arg = "GET.FORMULA('" & p & "[" & f & "]" & s & "'!" & _
Range(c).Range("A1").Address(, , xlR1C1) & ")"
Обратите внимание, что результат будет иметь формулы, использующие R1C1
обозначение вместо A1
нотации.
Преобразование обратно в A1
запись (если вы действительно хотите это сделать) оставлена читателю в качестве упражнения.