Копировать диапазон данных, но игнорировать (не копировать) ячейки с формулой

Question

У меня есть лист сметы, который содержит несколько листов и формул. Пользователь может ввести свои данные в книгу, и автоматически рассчитываются различные финансовые сценарии. Главная книга содержит несколько ячеек, которые содержат формулы и могут быть перезаписаны пользователем. Это хорошо, поскольку рабочий лист проецируется месяц за месяцем, и его необходимо обновлять фактическими записями для обеспечения точности прогнозов.

Иногда я обновляю / обновляю рабочую таблицу составления бюджета и хочу, чтобы пользователь мог экспортировать свои данные из старой рабочей таблицы и импортировать их в новую рабочую таблицу. Я создал макрос, который экспортирует данные для определенных диапазонов. Я также создал макрос, который импортирует диапазон данных на новый лист.

Однако моя проблема заключается в том, что экспортируемый макрос также преобразует заранее определенные вычисления из их исходной формулы (= A1 + B2, например) в любой результат для этой формулы (например, 1200 долл. США). Это создает проблемы для будущих прогнозов в других диапазонах данных, поскольку формула теперь заменена статическим числом, которое не может изменяться в зависимости от других ежемесячных депозитов / изъятий.

Я попытался экспортировать данные за вычетом любых ячеек, которые содержат формулы, но безуспешно. Я приложил свой рабочий код экспорта (так как у меня много листов и диапазонов, я опубликовал только минимум, чтобы показать, что у меня работает). Я также приложил код, который использовал для игнорирования ячеек с формулами (вдохновленный этим постом Макрос копирования / вставки Excel VBA: игнорировать ячейки с формулами ). Любая помощь очень ценится. Как очевидно, я новичок в VBA и почти ничего не знаю об этом!

КОД РАБОЧЕГО ЭКСПОРТА:

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"
ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value
ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value
End Sub

НЕ РАБОТАЮЩИЕ: ИГНОРНЫЕ КЛЕТКИ С ФОРМУЛЫ

Sub example()
Dim source As Range
Dim target As Range
Set source = ActiveWorkbook.Sheets("HELOC").Range("D13:F877")
Set target = ThisWorkbook.Sheets("HELOC").Range("D13:F877")
copy_non_formulas source:=source, target:=target
copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")
End Sub

Public Sub copy_non_formulas(source As Range, target As Range)
'Assumes that all formulas start with '=' and all non formulas do not
Dim i As Long
Dim j As Long
Dim c As Range
For i = 1 To source.Rows.Count
    For j = 1 To source.Columns.Count
        Set c = source(RowIndex:=i, ColumnIndex:=j)
        If Left(c.Formula, 1) <> "=" Then
            target(RowIndex:=i, ColumnIndex:=j).Value = c.Value
        End If
    Next j
Next i
End Sub

Answer 1

Вот простая подпрограмма, которая перемещает только постоянные значения из Sheet1 в новую книгу.

Это должно быть просто отредактировать это в соответствии с вашими требованиями, но дайте мне знать, если у вас есть какие-либо проблемы.

Sub CopyWithoutFormulas()
    Dim newWorkbook As Workbook
    Set newWorkbook = Workbooks.Add

    Dim formulas As Range
    On Error Resume Next
    Set formulas = Sheet1.UsedRange.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If formulas Is Nothing Then
        'no formulas so move all values across in one batch
        newWorkbook.Worksheets(1).Range(Sheet1.UsedRange.Address).Value = Sheet1.UsedRange.Value
    Else
        'formulas found so only move constants across
        Dim r As Range
        For Each r In Sheet1.UsedRange
            If Intersect(r, formulas) Is Nothing Then
                newWorkbook.Worksheets(1).Range(r.Address).Value = r.Value
            End If
        Next
    End If
End Sub

Answer 2

Я попробовал несколько предложений с этого сайта, а также другие, но, поскольку я не совсем уверен, как писать код, я ничего не получил. Для записи, код, который я разместил как «рабочий», я настроил из онлайн-источника, и он делает именно то, что я хочу ... за исключением того, что копирует ячейки с формулами. «Рабочий» код создает новую рабочую книгу с теми же вкладками и экспортирует данные в те же соответствующие ячейки. Теперь, если только я могу редактировать свой существующий «рабочий» код, чтобы исключить копирование ячеек с формулами? Для справки здесь приведен полный «рабочий» код за вычетом всех диапазонов листов / данных.

Sub GenerateData()
Dim strFile As String
'New workbook with 3 sheets
Workbooks.Add xlWBATWorksheet
ActiveSheet.Name = "Financial Info"
Sheets.Add(After:=Sheets(1)).Name = "HELOC"
Sheets.Add(After:=Sheets(2)).Name = "Accelerated Mortgage"
Sheets.Add(After:=Sheets(3)).Name = "Accelerated 2nd Loan"

ActiveWorkbook.Sheets("Financial Info").Range("G6:G8").Value = ThisWorkbook.Sheets("Financial Info").Range("G6:G8").Value
ActiveWorkbook.Sheets("Financial Info").Range("G11:G13").Value = ThisWorkbook.Sheets("Financial Info").Range("G11:G13").Value

ActiveWorkbook.Sheets("HELOC").Range("D13:F74").Value = ThisWorkbook.Sheets("HELOC").Range("D13:F74").Value
ActiveWorkbook.Sheets("HELOC").Range("D86:F147").Value = ThisWorkbook.Sheets("HELOC").Range("D86:F147").Value

ActiveWorkbook.SaveAs "Exported Data.xlsx"

End Sub

Answer 3

Я попробовал ваш код, и он, кажется, работает просто отлично.Как происходит сбой, на каких данных?

Вы на самом деле копируете значения из диапазона и вставляете их в тот же диапазон , поэтому невозможно узнать, сработало ли это.Попробуйте обновить эти строки, установить источник и цель на разные диапазоны.Например, вместо

copy_non_formulas source:=Range("D13:F74"), target:=Range("D13:F74")
copy_non_formulas source:=Range("D86:F147"), target:=Range("D86:F147")

вы можете попробовать

copy_non_formulas source:=Sheets(1).Range("D13:F74"), target:=Sheets(2).Range("D13:F74")
copy_non_formulas source:=Sheets(1).Range("D86:F147"), target:=Sheets(2).Range("D86:F147")