Question

Hello stackoverflow社区，

提前，我对VBA和Excel Macros很新，所以请原谅我不理解某些东西。我在Excel 2010中有2张，每张1张。

某些行相等而不是。

在测试一些不同的代码时，这一个：

With ActiveSheet
    Set Rng = Range("A1", Range("L1048576").End(xlDown))
    Rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End With

管理以删除一张纸上的重复项。

我需要做的是：

将重复项设置为红色和唯一绿色，而不是删除它们。另外，我需要将纸张彼此进行比较，而不是在一张纸上进行比较。

我希望这个问题是可以理解的。

编辑：

这就是我到目前为止所得到的：

Sub duplicateTest()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range

    Set ws1 = Worksheets(2)
    Set ws2 = Worksheets(3)

    Set rng1 = ws1.Range("B" & Rows.Count).End(xlDown)
    Set rng2 = ws2.Range("D" & Rows.Count).End(xlDown)

        If Range("D" & Rows.Count).End(xlDown).Value = "" Then

        Else

    rng2.EntireRow.Interior.Color = 7658646 '                           <~~     The color for uniques

        End If

    For Each cell1 In rng1
        For Each cell2 In rng2
            If cell1.Value <> "" And cell2.Value <> "" Then
                If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value Then
                    cell2.EntireRow.Interior.Color = 255 '              <~~  The color for duplicates
                    End If
            End If
        Next cell2
    Next cell1
End Sub

将其更改为此，因为它应该在列的末尾执行。

Set rng1 = ws1.Range("B" & Rows.Count).End(xlDown)

这个没有将空白单元格着色

If Range("D" & Rows.Count).End(xlDown).Value = "" Then

Else

为整行而不是1个单元格着色

rng2.EntireRow.Interior.Color = 7658646
cell2.EntireRow.Interior.Color = 255

我现在遇到的问题是它没有着色任何东西。那说它不会给我一个错误信息，所以我猜它有点像代码工作？我无法在代码中发现可能导致此错误的错误，所以我猜它必须是别的。

提前致谢

此致，Crossie

Answer 1

您必须处理范围声明以适合您的工作簿。如果需要，可以做一些动态的事情，但根据数据的外观有不同的解决方案。

当然，颜色也可以修改。我已经标记了代码所在的位置。

Sub duplicateTest()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range

    Set ws1 = Worksheets(2)
    Set ws2 = Worksheets(3)

    Set rng1 = ws1.Range("A1:A100")
    Set rng2 = ws2.Range("A1:A100")

    rng2.Interior.Color = 7658646 '              <~~ The color for uniques
    rng2.Offset(0, 1).Interior.Color = 7658646 ' <~~

    For Each cell1 In rng1
        For Each cell2 In rng2
            If cell1.Value <> "" And cell2.Value <> "" Then
                If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value Then
                    cell2.Interior.Color = 255 '              <~~  The color for duplicates
                    cell2.Offset(0, 1).Interior.Color = 255 ' <~~
                End If
            End If
        Next cell2
    Next cell1
End Sub

回复您的修改：

    If Range("D" & Rows.Count).End(xlDown).Value = "" Then
    Else
rng2.EntireRow.Interior.Color = 7658646
    End If

这不会给任何颜色带来任何影响，因为你是在对编译器说：

如果工作表中最底部的单元格为空，则不执行任何操作。如果它不为空，请使用此值为其着色。

我们可以通过询问编译器在评估您提供的表达式时查看的地址来证明这一点：

? Range("D" & Rows.Count).End(xlDown).Address
$D$1048576

我们可以看到这会产生一个单元格，其位置在D列第1048576行。

这是我的建议，看看这是否更好：

（请注意：在代码顶部，您必须更改Worksheet引用，以便它与您在工作簿中使用的工作表相匹配。我使用了数值，含义编号1和表编号2.您还可以使用实际工作表名称，如下所示：Worksheets("Sheet 1")）

Sub duplicateTest()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range, rng2 As Range

    Set ws1 = Worksheets(1)
    Set ws2 = Worksheets(2)

    Set rng1 = ws1.Range("B1", Range("B" & Rows.Count).End(xlUp).Address)
    Set rng2 = ws2.Range("B1", Range("B" & Rows.Count).End(xlUp).Address)

    ' Let's color the entire used range. We'll fix the colors later.
    Range(rng2, rng2.Offset(10)).Interior.Color = 7658646 ' <~~ The color for uniques

    For Each cell1 In rng1
        For Each cell2 In rng2
            If cell1.Value <> "" And cell2.Value <> "" Then
                ' If the cells are duplicate, color them
                If cell1.Value = cell2.Value And cell1.Offset(0, 1).Value = cell2.Offset(0, 1).Value And cell1.Offset(0, 10).Value = cell2.Offset(0, 10).Value Then
                    Range(cell2, cell2.Offset(0,10)).Interior.Color = 255 ' <~~ The color for duplicates
                End If
            ElseIf cell2.Value = "" Then
                ' If the cell in sheet 2 is empty, remove the coloring
                cell2.EntireRow.Interior.Color = xlNone
            End If
        Next cell2
    Next cell1
End Sub

通过宏

1 个答案: