excel 在特定范围内的每一行中循环,但在下一行中开始新条件

bogh5gae  于 2022-12-14  发布在  其他
关注(0)|答案(1)|浏览(153)

我希望检测行中的重复值并突出显示该值。
我找到了代码,它工作了。但问题是,代码在一个范围内循环,它会突出显示每个有重复的值。
我想要的是,代码/循环只在每一行起作用。然后在下一行,循环再次从头开始。

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

我不知道如何使用数组执行此操作。

  • 注意:我必须执行两次For each,第一次在行中,第二次在单元格中。因为1 For each无法检测单元格。值(对象'_Global'的方法'Range'失败)
kwvwclae

kwvwclae1#

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

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

相关问题