我可以删除重复项并保持范围内的公式吗?

时间:2016-09-01 12:54:50

标签: excel vba duplicates

我正在使用remove duplicates值来删除重复的行,但是,我想删除整行,而我想在Excel搜索重复项的范围中间保留公式。这可能吗?

插图:

1 Identifier1 Formulatopreserve Datablock1
2 Identifier2 Formulatopreserve Datablock2
3 Identifier1 Formulatopreserve Datablock1

目前,Excel将产生以下结果:

1 Identifier1 Formulatopreserve Datablock1
2 Identifier2 Formulatopreserve Datablock2
3 

但我希望如此:

1 Identifier1 Formulatopreserve Datablock1
2 Identifier2 Formulatopreserve Datablock2
3             Forumlatopreserve

更多背景: 我写了一个子,我导入了大量的数据行,然后在我的数据表的右边使用sumifs公式来对那些具有相同标识符的行求和。我将结果值传回原始数据集并删除边计算。然后,我删除重复项。

代码如下:

Sub Import()
'Other dim statements    
Dim k As Integer: k = 0
Dim toname As String: toname = ThisWorkbook.Name

Application.ScreenUpdating = False

'Clear previous inputs
Workbooks(toname).Worksheets("input A").Range("B6:B1000").ClearContents
Workbooks(toname).Worksheets("input A").Range("I6:AO1000").ClearContents

'Importing happens here, data is in column B and column I to AO
'Columns C-H contain forumlas which I would like to keep

'Remove and sum duplicate
Set ws = Workbooks(toname).Worksheets("input A")
lastrw = ws.Cells(1048576, 2).End(xlUp).Row
ws.Range("AP6:BV" & lastrw).FormulaR1C1 = "=IFERROR(SUMIFS(C[-33],C2,RC2),"""")"
ws.Range("I6:AO" & lastrw).Value = ws.Range("AP6:BV" & lastrw).Value
ws.Range("AP6:BV" & lastrw).ClearContents
With ws.Range("B6:AO" & lastrw)
       .RemoveDuplicates Array(1, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40), xlNo
End With

'Remove empty rows (empty in B) but content in column I
lastrw2 = ws.Cells(1048576, 9).End(xlUp).Row
For j = 6 To lastrw2
If ws.Cells(j, 2) = "" Then
ws.Rows(j).EntireRow.Delete
End If
Next j

Application.ScreenUpdating = True

End Sub

我唯一想解决这个问题的方法是在sub的末尾包含代码,该代码将我想要的公式写回相应的单元格,然后使用自动填充将其复制下来。但是因为它是7列,即14行代码,如果有办法,我宁愿不这样做。

感谢您的帮助:)

1 个答案:

答案 0 :(得分:0)

假设公式从第6行开始:

Dim fillRange As Range
With Range("B6:AO" & lastrw)
    For Each fillRange In .Columns
        If fillRange.Cells(1, 1).HasFormula Then fillRange.FillDown
    Next
End With