从宏

Question

我制作了一个数据输入表单，用于在数据表中广告或更新行。以http://www.contextures.com/exceldataentryupdateform.html为基础。表单有128行，其中5行是vlookup公式（第12,19,30,34,36行），在使用视图记录导航按钮时应排除这些公式。否则，如果使用导航按钮，公式将被删除并替换为值。

但我真的不知道如何做到这一点。我对VBA真的很陌生。这是我的第一个项目，所以非常感谢所有的帮助。

Sub ViewLogDown()

    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
    Dim rngA As Range

    Dim lRec As Long
    Dim lRecRow As Long
    Dim lLastRec As Long
    Dim lastRow As Long
    Application.EnableEvents = False

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("Werknemers")
    Set rngA = ActiveCell

    With historyWks
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row - 1
        lLastRec = lastRow - 1
    End With

    With inputWks
        lRec = .Range("CurrRec").Value
        If lRec < lLastRec Then
            .Range("CurrRec").Value = lRec + 1
            lRec = .Range("CurrRec").Value
            lRecRow = lRec + 1
        historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 128)).Copy
        .Range("D5").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        inputWks.Range("OrderSel").Value = .Range("D5").Value
        rngA.Select
          End If
    End With
    Application.EnableEvents = True

End Sub

Answer 1

如果要复制和粘贴并排除基于公式的单元格，则可以使用Range对象的SpecialCells方法。 `xlCellTypeConstants＆＃39;将过滤掉没有公式和空白单元格的单元格。

E.g。用你的代码：

Dim rngSource As Range
Dim rngFilter As Range

Set rngSource = historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 128))
Set rngFilter = rngSource.SpecialCells(xlCellTypeConstants)

注意一旦粘贴Range将小于原始版本，因为带公式的单元格会打折。

您可以Union个不同的来电SpecialCells。所以要包含你可以使用的空格：

Dim rngSource As Range
Dim rngFilter As Range

Set rngSource = historyWks.Range(historyWks.Cells(lRecRow, 3), historyWks.Cells(lRecRow, 128))

Set rngFilter = Union( _
    rngSource.SpecialCells(xlCellTypeConstants), _
    rngSource.SpecialCells(xlCellTypeBlanks) _
)

使用SpecialCells的最小示例的示例代码：

Option Explicit

Sub TestRangeCopyExcludingFormulas()

    Dim ws As Worksheet
    Dim rngToCopy As Range
    Dim rngToCopyExcludingFormulas As Range
    Dim rngToPaste As Range
    Dim rngCell As Range

    ' set the worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ' set the range to copy excluding formulas
    Set rngToCopy = ws.Range("B3:B13")

    ' copy just the constants
'    Set rngToCopyExcludingFormulas = rngToCopy.SpecialCells(xlCellTypeConstants)

    ' copy constants and blanks
    Set rngToCopyExcludingFormulas = Union( _
        rngToCopy.SpecialCells(xlCellTypeConstants), _
        rngToCopy.SpecialCells(xlCellTypeBlanks))

    ' set the range to paste to
    Set rngToPaste = ws.Range("E3")

    ' do the copy and paste
    rngToCopyExcludingFormulas.Copy
    rngToPaste.PasteSpecial Paste:=xlPasteValues
    ' use transpose etc
'    rngToPaste.PasteSpecial Paste:=xlPasteValues, Transpose:=True

    ' remove the dancing ants
    Application.CutCopyMode = False

End Sub

见截图：