在特定范围内的每一行中循环，但在每一行中开始一个新条件

Question

我想检测一行中的重复值并突出显示该值。

我找到了代码并且它有效。但问题是，代码在一个范围内循环，它会突出显示每个有重复的值。

我想要的是，代码/循环只适用于每一行。然后在下一行中，循环再次从头开始。

Sub DetectDuplicate()
    Dim rng As Range, row As Range, cell As Range

    Set rng = Range("D6:AV15").SpecialCells(xlCellTypeVisible)
    
    For Each row In rng.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
End Sub

代码结果：

预期成绩：

为此，我必须编写这样的代码，因为我有大约 50 行要执行。这段代码会让我写一段感觉没必要的更长的代码。

Sub DetectDuplicateMain()
    Dim rng As Range, row As Range, cell As Range
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range
    Dim rng6 As Range, rng7 As Range, rng8 As Range, rng9 As Range, rng10 As Range
    Dim rng11 As Range, rng12 As Range, rng13 As Range, rng14 As Range, rng15 As Range
    Dim rng16 As Range, rng17 As Range, rng18 As Range, rng19 As Range, rng20 As Range

    Set rng1 = Range("D6:AV6").SpecialCells(xlCellTypeVisible)
    Set rng2 = Range("D7:AV7").SpecialCells(xlCellTypeVisible)
    Set rng3 = Range("D8:AV8").SpecialCells(xlCellTypeVisible)
    Set rng4 = Range("D9:AV9").SpecialCells(xlCellTypeVisible)
    Set rng5 = Range("D10:AV10").SpecialCells(xlCellTypeVisible)
    Set rng6 = Range("D11:AV11").SpecialCells(xlCellTypeVisible)
    Set rng7 = Range("D12:AV12").SpecialCells(xlCellTypeVisible)
    Set rng8 = Range("D13:AV13").SpecialCells(xlCellTypeVisible)
    Set rng9 = Range("D14:AV14").SpecialCells(xlCellTypeVisible)
    Set rng10 = Range("D15:AV15").SpecialCells(xlCellTypeVisible)
    
    For Each row In rng1.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng1(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
    
    For Each row In rng2.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng2(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng3.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng3(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng4.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng4(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng5.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng5(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng6.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng6(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng7.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng7(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng8.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng8(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng9.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng9(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row

    For Each row In rng10.Rows
        For Each cell In row.Cells
            If WorksheetFunction.CountIf(Range(rng10(1, 1), cell), cell.Value) > 1 And Not cell.Value = " " Then
                cell.Interior.Color = vbRed
            Else
                cell.Interior.Pattern = xlNone
            End If
        Next cell
    Next row
End Sub

我不知道如何用数组来做到这一点。

*注意：我必须为每个做两次，第一次连续，第二次在一个单元格中。因为 1 For each 无法检测到 cell.Value（对象 '_Global' 的方法 'Range' 失败）

Answer 1

更短的是使用循环遍历整个范围内的每一行：

Sub DetectDuplicateMain()
    Dim row As Range, cell As Range, ws As Worksheet
    
    Set ws = ActiveSheet 'or whatever
    
    For Each row In ws.Range("D6:AV15").Rows
        For Each cell In row.Cells
            If Len(Trim(cell.Value)) > 0 Then
                If WorksheetFunction.CountIf(ws.Range(row.Cells(1), cell), cell.Value) > 1 Then
                    cell.Interior.Color = vbRed
                Else
                    cell.Interior.ColorIndex = xlNone
                End If
            End If
        Next cell
    Next row
End Sub