[已解决]判断相同的问题

HuYanY

附件 判断区间相同数附件.rar (361.43 KB, 下载次数: 13)

2013-6-28 06:55 上传

点击文件名下载附件

谢谢！

最佳答案

月排行榜 / 总排行榜

csmctjg

2013-6-28 08:36

1. Sub aa()
   
2.     Dim i%, j%, str$, arr, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("Sheet2")
   
5.         arr = .Range("A1:I" & .Range("A" & Rows.Count).End(3).Row)
   
6.         For i = 1 To UBound(arr)
   
7.             If Not d.Exists(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9)) Then
   
8.                 d(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9)) = i
   
9.             Else
   
10.                 j = d(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9))
    
11.                 If InStr(str, "C" & j & ":I" & j & ",") = 0 Then str = str & "C" & j & ":I" & j & ","
    
12.             End If
    
13.             If Len(str) > 250 Then
    
14.                 .Range(Left(str, Len(str) - 1)).Interior.ColorIndex = 6
    
15.                 str = ""
    
16.             End If
    
17.         Next
    
18.         If str <> "" Then .Range(Left(str, Len(str) - 1)).Interior.ColorIndex = 6
    
19.     End With
    
20. End Sub

复制代码

跳转到最佳答案楼层

csmctjg

1. Sub aa()
   
2.     Dim i%, j%, str$, arr, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     With Sheets("Sheet2")
   
5.         arr = .Range("A1:I" & .Range("A" & Rows.Count).End(3).Row)
   
6.         For i = 1 To UBound(arr)
   
7.             If Not d.Exists(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9)) Then
   
8.                 d(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9)) = i
   
9.             Else
   
10.                 j = d(arr(i, 1) & "," & arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 6) & "," & arr(i, 7) & "," & arr(i, 9))
    
11.                 If InStr(str, "C" & j & ":I" & j & ",") = 0 Then str = str & "C" & j & ":I" & j & ","
    
12.             End If
    
13.             If Len(str) > 250 Then
    
14.                 .Range(Left(str, Len(str) - 1)).Interior.ColorIndex = 6
    
15.                 str = ""
    
16.             End If
    
17.         Next
    
18.         If str <> "" Then .Range(Left(str, Len(str) - 1)).Interior.ColorIndex = 6
    
19.     End With
    
20. End Sub

复制代码

HuYanY

csmctjg 发表于 2013-6-28 08:36

老师您好！谢谢您帮助。我把代码复进楼主的附件里，试了一下，相同那几组，没有反应（未标色以示区别），不知何故？

csmctjg

相同的是不是只要第一组标色？

HuYanY

csmctjg 发表于 2013-6-28 09:16
相同的是不是只要第一组标色？

只标一组即可。第一组也行。

csmctjg

是就第一组标了颜色。
相同那几组，没有反应（未标色以示区别），稍举几行例子出来，我再瞧瞧是什么原因。

HuYanY

csmctjg 发表于 2013-6-28 09:30
是就第一组标了颜色。
相同那几组，没有反应（未标色以示区别），稍举几行例子出来，我再瞧瞧是什么原因。

附件中 那几行数据，就有两个区间有相同的。

csmctjg

我用了函数进行验证，如下图，有相同的数的行都筛选了出来，同时对第一组进行了标色。