复制数据范围但忽略（不复制）带有公式的单元格

Question

我有一个包含多个工作表和公式的预算工作表。用户可以将他的数据输入账本，自动计算各种金融场景。分类帐包含一些包含公式的单元格，并且可能被用户覆盖。这很好，因为工作表每月预测月，并且必须使用实际条目进行更新以保持预测准确。

有时我会更新/升级预算工作表，并希望用户能够从旧工作表中导出他的数据并将其导入新工作表。我创建了一个宏，用于导出特定范围的数据。我还创建了一个将数据范围导入新工作表的宏。

但是，我的问题是，要导出的宏还将预定计算从其原始公式（例如 =A1+B2）转换为该公式的任何结果（例如 $1,200）。这会导致其他数据范围内的未来预测出现问题，因为该公式现在已替换为无法根据其他每月存款/取款更改的静态数字。

我已尝试导出数据减去任何包含公式但未成功的单元格。我附上了我的工作导出代码（因为我有很多工作表和范围，我只发布了最低限度来展示我的工作）。我还附上了用于忽略带有公式的单元格的代码（受此帖子 Excel VBA Copy / Paste macro: Ignore cells with Formulas 的启发）。 任何帮助是极大的赞赏。很明显，我是 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

我试过你的代码，它似乎工作得很好。它是如何失败的，基于什么数据？

您实际上是从一个范围复制值并将它们粘贴到到同一范围，因此无法知道它是否有效。尝试更新这些行，将源和目标设置为不同的范围。例如，改为

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")

Answer 3

我已经尝试了该站点以及其他站点的一些建议，但是由于我一开始并不确定如何编写代码，所以我一无所获。作为记录，我发布为“工作”的代码是我从在线资源中调整的，它完全符合我的要求……除了它用公式复制单元格。 “工作”代码创建一个具有相同选项卡的新工作簿，并将数据导出到相同的相应单元格。现在，如果我可以编辑我现有的“工作”代码以消除使用公式复制单元格？这里的参考是完整的“工作”代码减去所有工作表/数据范围。

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