Question

我对VBA代码知之甚少，但我可以按照给定示例中的逻辑线进行操作。所以我用Google搜索并找到了我编辑的代码，以突出显示工作表中的重复项。但是，我有一张三张工作簿。我想将其改编为比较表1和表3，然后突出显示表1中的重复项。

Sub Highlight_Dups()

Dim startRow As Integer
startRow = 2

Dim row As Integer
row = startRow

Do While (Range("A" & row).Value <> "")

Dim innerRow As Integer
innerRow = row + 1

Dim StudentID As String
Dim DT As String
Dim Description As String

StudentID = Range("A" & row).Value
DT = Range("H" & row).Value
Description = Range("J" & row).Value

Do While (Range("A" & innerRow).Value <> "")


    If (Range("A" & innerRow).Value = StudentID And Range("H" & innerRow).Value = DT And Range("J" & innerRow).Value = Description) Then
        Range("X" & row).Value = Range("X" & row).Value & innerRow & ", "
        Range("X" & innerRow).Value = Range("X" & innerRow).Value & row & ", "
        Rows(row).Interior.ColorIndex = 6

        Rows(innerRow).Interior.ColorIndex = 6
    End If

innerRow = innerRow + 1
Loop

row = row + 1
Loop

MsgBox "done", vbOKOnly, "done"

End Sub

有关如何添加??? =表格（“Sheet1”）和???的任何帮助=表格（“Sheet3”）会帮助我很多。感谢

Answer 1

首先，您应该声明2个工作表对象，以便于阅读，以及将来的代码维护更容易：

Dim ws1 As Worksheet
Dim ws2 As Worksheet

'use this approach if your sheet's name is dinamic but never changes it's order
'Set ws1 = ThisWorkbook.Sheets(1)
'Set ws2 = ThisWorkbook.Sheets(2)

'use this if name is static
Set ws1 = ThisWorkbook.Sheets("name of worksheet1")
Set ws2 = ThisWorkbook.Sheets("name of worksheet2")

然后将Sheets对象放在这样的特定位置（注意'ws1和'ws2'）：

Dim StudentID As String
Dim DT As String
Dim Description As String

Do While (ws1.Range("A" & Row).Value <> "")
    innerRow = Row + 1

    StudentID = ws1.Range("A" & Row).Value
    DT = ws1.Range("H" & Row).Value
    Description = ws1.Range("J" & Row).Value

    Do While (ws2.Range("A" & innerRow).Value <> "")

        If (ws2.Range("A" & innerRow).Value = StudentID And ws2.Range("H" & innerRow).Value = DT And ws2.Range("J" & innerRow).Value = Description) Then
            'not sure what you are trying to do with this 3 lines, change it for your own needs
            ws1.Range("X" & Row).Value = ws2.Range("X" & Row).Value & innerRow & ", "
            ws1.Range("X" & innerRow).Value = ws2.Range("X" & innerRow).Value & Row & ", "
            ws1.Rows(Row).Interior.ColorIndex = 6

            ws1.Rows(innerRow).Interior.ColorIndex = 6
        End If

        innerRow = innerRow + 1
    Loop

    Row = Row + 1
Loop
End Sub

ps：我无法测试它，因为你没有提供你的基础。但既然你说你可以阅读代码并理解它的逻辑，我想你会没事的。）

Answer 2

您可能需要考虑放弃循环遍历每个单元格的繁重任务，同时将其与其他单元格进行比较并使用一对条件格式设置规则。

Option Explicit

Private Sub cfrS1S3dupes()

    With ThisWorkbook.Worksheets("sheet1")
        With .Range(.Cells(2, "A"), .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, "J"))
            'get rid of pre-existing cfrs
            .FormatConditions.Delete

            'if duplicate in sheet1 found below row, then fill red
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=countifs($a$2:$a2, $a2, $h$2:$h2, $h2, $j$2:$j2, $j2)>1")
                .Interior.Color = 255 'this is the color red
            End With

            'if duplicate anywhere in sheet3, then fill green
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=countifs(sheet3!$a:$a, $a2, sheet3!$h:$h, $h2, sheet3!$j:$j, $j2)")
                .Interior.Color = 5287936 'this is the color green
            End With
        End With
    End With

End Sub

VBA突出显示两个工作表中的重复行

2 个答案: