[英]VBA code to loop in each row within a specific range, but the loop must start a new criteria in every next row
I want to make a code that can detect a duplicate value in a row and highlight that value.我想制作一个可以连续检测重复值并突出显示该值的代码。 I found the code and it works perfectly.
我找到了代码,它工作得很好。 But the problem is, the code loop within a range and it will highlight every value that have a duplicate.
但问题是,代码循环在一个范围内,它会突出显示每个有重复的值。 What I want is, the code/loop is only works in each row.
我想要的是,代码/循环只适用于每一行。 Then in the next row, the loop start from the beginning again.
然后在下一行,循环再次从头开始。
I make this, with the result below.我做了这个,结果如下。
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
Result: Code results结果:代码结果
But what I want is to be like this.但我想要的就是这样。 Expected results: Expected code results
预期结果:预期代码结果
To do that, I have to make a code like this which is so annoying because I have about 50 rows to be executed.为此,我必须编写这样的代码,这很烦人,因为我有大约 50 行要执行。 So this code will make me write a longer code that feel unnecessary.
所以这段代码会让我写出更长的代码,感觉没有必要。
The code:编码:
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
Anyone can help me?任何人都可以帮助我吗? I don't know how to do this with array.
我不知道如何用数组来做到这一点。 So if you guys have some answer, please help me!
所以如果你们有什么答案,请帮助我!
*Note: I have to do twice For each, first in a row and second in a cell. *注意:我必须为每个做两次,第一次在一行中,第二次在一个单元格中。 Because 1 For each can't detect the cell.Value (Method 'Range' of object '_Global' failed)
因为 1 For each 无法检测到 cell.Value (方法 'Range' of object '_Global' failed)
Shorter using a loop to go over each row in the full range:在整个范围内的每一行上使用 go 循环更短:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.