从macros中的范围中排除具有公式的行

我制作了一个数据input表单,用于在数据表中广告或更新行。 以此http://www.contextures.com/exceldataentryupdateform.html为基础。 该表格有128行,其中5个是使用视图logging导航button时应该排除的查找公式(第12,19,30,34,36行)。 否则,如果使用导航button,公式将被删除并replace为一个值。

但我真的不知道如何做到这一点。 我真的是新来的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 

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

例如你的代码:

 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 

看截图:

在这里输入图像说明