2017-04-12 62 views
1

我製作了一個數據輸入表單,用於廣告或更新數據表中的行。以此http://www.contextures.com/exceldataentryupdateform.html爲基礎。該表單有128行,其中5個是使用視圖記錄導航按鈕時應排除的查找公式(第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 

回答

0

如果你想複製和粘貼,不包括基於公式的細胞,然後你可以使用Range對象的SpecialCells方法。 `xlCellTypeConstants'將過濾掉沒有公式的單元格空白單元格。

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 

見截圖:

enter image description here

+0

太好了,我覺得這是我需要但你可以放置也告訴我如何將其嵌入我的代碼?因爲我試圖粘貼它,但它給了我一個錯誤。 – user3425887

+0

SUPER THX爲您提供幫助! – user3425887

+0

我想結束的列表應該看起來像這樣。在你底部的例子中,他們向上移動。那會攪亂數據。 [1]:https://i.stack.imgur.com/ijYVP.png – user3425887