0

我有以下代码可以拾取重复的行，但是我无法让代码以粗体突出显示重复项以及同时删除它们。

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim rng As Range

With ActiveSheet

    iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
    For i = 1 To iLastRow
        If .Evaluate("SUMPRODUCT(--(A" & i & ":A" & iLastRow & "=A" & i & ")," & _
    "--(D" & i & ":D" & iLastRow & "=D" & i & ")," & _
    "--(F" & i & ":F" & iLastRow & "=F" & i & ")," & _
    "--(J" & i & ":J" & iLastRow & "=J" & i & ")," & _
        "--(K" & i & ":K" & iLastRow & "=K" & i & "))") > 1 Then
            If rng Is Nothing Then
                Set rng = .Cells(i, "A").Resize(, 11)
            Else
                Set rng = Union(rng, .Cells(i, "A").Resize(, 11))
            End If
        End If
    Next i

    **If Not rng Is Nothing Then rng.Delete.font.bold = true**


End With

结束子

数据集的示例和所需的输出可以在下面的以下可下载链接中看到：

https://www.dropbox.com/s/7rhktg6b4nk6ig0/Bold_highlight_Duplicate%20.xlsm

任何帮助将不胜感激。谢谢你。

编辑：

澄清一下，这就是它的样子，只是输入应该被删除，并且粗体突出显示应该出现在输出部分：

在此处输入图像描述

4

1 回答 1

0

而不是**If Not rng Is Nothing Then rng.Delete.font.bold = true**使用以下内容：

If Not rng Is Nothing Then
  with rng
   .Offset(.Areas(.Areas.Count).Rows(.Areas(.Areas.Count).Rows.Count).Row + 1).Font.Bold = True
   .Delete
  end with
End If

这是如何工作的？

好吧，您可以在测试重复项时设置粗体指示器，但是您采用了不同的方法，这是不允许的。

所以，你rng是一个多区域的选择。

您必须到达最后一个区域，然后到达该区域的最后一行，然后检索您所在的实际行。然后为之间的空格添加 +1。现在您知道输入部分覆盖了多少行 + 到输出的间隙，并且您通过此计数将您的选择偏移到输出部分。

但是，取决于您的输入/输出，可能会出现复杂情况-我在您的示例中对此进行了简要测试-有效。不过，我认为使用不同类型的循环和重复检测会更好。

于 2012-10-25T11:54:17.000 回答