[已解决]求助一个判断的问题

ryoryo66

我想判断,B和D:K这几个单元格之间是否有重复的数据,如果有,就在重复的上面显示红色.一行一行的判断,列数最多是20列,但是C列肯定是不参与判断的.就是隔着一个C列.
请问一下这个代码应该怎么写啊?

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-3-8 14:52

ryoryo66 发表于 2021-3-8 22:14
数字就是1-99这样,最多就是2位数的.

Sub demo()
   arr = [b1].CurrentRegion
   For i = 1 To UBound(arr)
      ReDim v(1 To 99)
      For k = 1 To UBound(arr, 2)
         If k <> 2 And arr(i, k) Then v(arr(i, k)) = v(arr(i, k)) + 1
      Next
      For k = 1 To UBound(arr, 2)
         If k <> 2 And arr(i, k) Then
            If v(arr(i, k)) > 1 Then Cells(i, k + 1).Interior.ColorIndex = 22
         End If
      Next
   Next
End Sub


祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

ryoryo66 发表于 2021-3-8 22:14
数字就是1-99这样,最多就是2位数的.

Sub demo()
   arr = [b1].CurrentRegion
   For i = 1 To UBound(arr)
      ReDim v(1 To 99)
      For k = 1 To UBound(arr, 2)
         If k <> 2 And arr(i, k) Then v(arr(i, k)) = v(arr(i, k)) + 1
      Next
      For k = 1 To UBound(arr, 2)
         If k <> 2 And arr(i, k) Then
            If v(arr(i, k)) > 1 Then Cells(i, k + 1).Interior.ColorIndex = 22
         End If
      Next
   Next
End Sub


祝順心，南無阿彌陀佛！

砂海

像是彩票 ,
你自己一点 代码都没有 , 不是卡一点了.

ryoryo66

砂海 发表于 2021-3-8 15:44
像是彩票 ,
你自己一点 代码都没有 , 不是卡一点了.

我那个代码只能B:K的连续区域对比.这样隔着一列,就没有办法了.

Dim c As Integer
Dim r As Integer
For r = 1 To Cells(Rows.Count, 1).End(3).Row
For c = 2 To 13
If Application.WorksheetFunction.CountIf(Range("b" & r & ":k" & r), Cells(r, c)) > 1 And Cells(r, c) <> "" Then
Cells(r, c).Interior.ColorIndex = 22
End If
Next
Next

砂海

ryoryo66 发表于 2021-3-8 16:04
我那个代码只能B:K的连续区域对比.这样隔着一列,就没有办法了.

Dim c As Integer

这个完全是工作表函数的思路 , vba的味道很淡,

按 你这个思路 可以把问题 成分为2个,
1) countif( d:k,d:k)=1 这个是你已有的 ;
2) countif(d:k , b)=0
2个条件同时成立就 达到要求 了.

你用的是 单元格 循环 , 进阶的话 使用 数组/字典

cutecpu

數字有範圍嗎？ 1 ~ 99 這樣嗎？

ryoryo66

cutecpu 发表于 2021-3-8 19:54
數字有範圍嗎？ 1 ~ 99 這樣嗎？

数字就是1-99这样,最多就是2位数的.

cui26896

Sub test()
Dim ar, i&, j&, n&, d, mrow%
  Set d = CreateObject("Scripting.Dictionary")
  mrow = Cells(Rows.Count, "B").End(xlUp).Row
  For i = 1 To mrow
    ar = Range(Cells(i, "B"), Cells(i, "U"))
    For j = 1 To UBound(ar, 2)
      If ar(1, j) <> Empty And j <> 3 Then
        d(ar(1, j)) = j
        For n = 1 To UBound(ar, 2)
          If d.exists(ar(1, n)) And n <> j Then
            Cells(i, j + 1).Interior.ColorIndex = 3
            Cells(i, n + 1).Interior.ColorIndex = 3
          End If
        Next
        d.RemoveAll
      End If
    Next
  Next
End Sub