[已解决]求多列中，每行数据都完全相同的列的列号？

403300768

求多列中，每行数据都完全相同的列的列号？因这些列的内容不同设置不同颜色。

最佳答案

月排行榜 / 总排行榜

xdragon

2014-10-19 15:23

1. Sub test()
   
2.     Dim arr, re, d, i%, sr$, col%
   
3.     arr = Range("V6:BX9").Value
   
4.     ReDim re(1 To 1, 1 To UBound(arr, 2))
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr, 2)
   
7.         sr = arr(1, i) & "|" & arr(2, i) & "|" & arr(3, i) & "|" & arr(4, i)
   
8.         If d.exists(sr) Then
   
9.            col = d(sr)(0) + 21
   
10.            re(1, d(sr)(0)) = col
    
11.            Union(Range(Cells(6, col), Cells(9, col)), Cells(14, col)).Interior.Color = d(sr)(1)
    
12.            d(sr) = Array(i, d(sr)(1))
    
13.            re(1, i) = i + 21
    
14.            Union(Range(Cells(6, i + 21), Cells(9, i + 21)), Cells(14, i + 21)).Interior.Color = d(sr)(1)
    
15.         Else
    
16.            d(sr) = Array(i, RGB(Int(Rnd * 256) + 1, Int(Rnd * 256) + 1, Int(Rnd * 256) + 1))
    
17.         End If
    
18.     Next
    
19.     Range("V14:BX14") = re
    
20. End Sub

复制代码

颜色是设置的随机色

跳转到最佳答案楼层

403300768

请高手帮忙，谢谢！！

xdragon

1. Sub test()
   
2.     Dim arr, re, d, i%, sr$, col%
   
3.     arr = Range("V6:BX9").Value
   
4.     ReDim re(1 To 1, 1 To UBound(arr, 2))
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr, 2)
   
7.         sr = arr(1, i) & "|" & arr(2, i) & "|" & arr(3, i) & "|" & arr(4, i)
   
8.         If d.exists(sr) Then
   
9.            col = d(sr)(0) + 21
   
10.            re(1, d(sr)(0)) = col
    
11.            Union(Range(Cells(6, col), Cells(9, col)), Cells(14, col)).Interior.Color = d(sr)(1)
    
12.            d(sr) = Array(i, d(sr)(1))
    
13.            re(1, i) = i + 21
    
14.            Union(Range(Cells(6, i + 21), Cells(9, i + 21)), Cells(14, i + 21)).Interior.Color = d(sr)(1)
    
15.         Else
    
16.            d(sr) = Array(i, RGB(Int(Rnd * 256) + 1, Int(Rnd * 256) + 1, Int(Rnd * 256) + 1))
    
17.         End If
    
18.     Next
    
19.     Range("V14:BX14") = re
    
20. End Sub

复制代码

颜色是设置的随机色

baksy

函数解决列号~
V14单元格复制以下公式，
三键回车(点击公式编辑栏中的任意位置，按住 shift、ctrl 两个键，然后敲enter键 )，
横拉；
=IF(SUM(IF(($V$6:$BX$6=V6)*($V$7:$BX$7=V7)*($V$8:$BX$8=V8)*($V$9:$BX$9=V9),1))>1,COLUMN(),"")

403300768

xdragon 发表于 2014-10-19 15:23
颜色是设置的随机色

谢谢老师，如果我想在v15:bx15中    同时显示出v6:bx6的数据和相同内容列的颜色，则代码该怎么变？
v15:bx15中

2

12

8

1

5

1

3

4

4

60

1

3

14

5

11

4

6

1

3

1

16

9

10

20

26

2

15

3

8

12

1

3

3

5

2

8

1

3

15

1

1

4

7

3

3

9

8

10

11

16

5

4

4

4

3

xdragon

1. Sub test()
   
2.     Dim arr, re, d, i%, sr$, col%
   
3.     arr = Range("V6:BX9").Value
   
4.     ReDim re(1 To 2, 1 To UBound(arr, 2))
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 1 To UBound(arr, 2)
   
7.         sr = arr(1, i) & "|" & arr(2, i) & "|" & arr(3, i) & "|" & arr(4, i)
   
8.         If d.exists(sr) Then
   
9.            col = d(sr)(0) + 21
   
10.            re(1, d(sr)(0)) = col
    
11.            Union(Range(Cells(6, col), Cells(9, col)), Cells(14, col).Resize(2)).Interior.Color = d(sr)(1)
    
12.            d(sr) = Array(i, d(sr)(1))
    
13.            re(1, i) = i + 21
    
14.            Union(Range(Cells(6, i + 21), Cells(9, i + 21)), Cells(14, i + 21).Resize(2)).Interior.Color = d(sr)(1)
    
15.         Else
    
16.            d(sr) = Array(i, RGB(Int(Rnd * 256) + 1, Int(Rnd * 256) + 1, Int(Rnd * 256) + 1))
    
17.         End If
    
18.         re(2, i) = arr(1, i)
    
19.     Next
    
20.     Range("V14:BX15") = re
    
21. End Sub

复制代码

不是很明白你的问题，是这样吗？

403300768

xdragon 发表于 2014-10-19 16:36
不是很明白你的问题，是这样吗？

是这样的，谢谢你老师。不好意思，再请教一个问题。针对最前的问题：如果数据区域是V6:BX12，结果显示在V18:BX18.那代码是否可以这样改，Sub test()    Dim arr, re, d, i%, sr$, col%
    arr = Range("V6:BX12").Value
    ReDim re(1 To 1, 1 To UBound(arr, 2))
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr, 2)
        sr = arr(1, i) & "|" & arr(2, i) & "|" & arr(3, i) & "|" & arr(4, i)& "|" & arr(5, i)& "|" & arr(6, i)& "|" & arr(7, i)
        If d.exists(sr) Then
           col = d(sr)(0) + 21
           re(1, d(sr)(0)) = col
           Union(Range(Cells(6, col), Cells(12, col)), Cells(18, col)).Interior.Color = d(sr)(1)
           d(sr) = Array(i, d(sr)(1))
           re(1, i) = i + 21
           Union(Range(Cells(6, i + 21), Cells(12, i + 21)), Cells(18, i + 21)).Interior.Color = d(sr)(1)
        Else
           d(sr) = Array(i, RGB(Int(Rnd * 256) + 1, Int(Rnd * 256) + 1, Int(Rnd * 256) + 1))
        End If
    Next
    Range("V18:BX18") = re
End Sub

xdragon

403300768 发表于 2014-10-19 17:14
是这样的，谢谢你老师。不好意思，再请教一个问题。针对最前的问题：如果数据区域是V6:BX12，结果显示在V ...

是的，cells(row,column)就是单元格的意思，18就是行，range("V18:BX18")=re 就是把re这个数组放在单元格中，所以你想要改只要改代码对应的位置就好了