把C列第7行数据循环分配到K列到O列中

爷们679

                        把C列第7行数据循环分配到K列到O列中.                                                                  例如         数字09  10  21 22 33 分配到K列,添加方框和颜色;                                                                         
                    数字03  04 15  16 27  28 分配到L列,添加方框和颜色;
                    数字01 12  13  24  25分配到M列,添加方框和颜色;
                    数字06 07 18 19 30 31分配到N列,添加方框和颜色;
                    数字02  05  08 11  14  17 20  23  26  29  32分配到O列,添加方框和颜色;

Chip_Kenny

1. Sub zz()
   
2. Dim ar, b(), d As Object, rng As Range
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ar = [r7].CurrentRegion.Value
   
5. ReDim b(UBound(ar))
   
6. With CreateObject("vbscript.regexp")
   
7.     .Pattern = "\d+"
   
8.     .Global = True
   
9.     For i = 1 To UBound(ar)
   
10.         For Each k In .Execute(ar(i, 1))
    
11.             d(Val(k)) = i
    
12.         Next
    
13.     Next
    
14. End With
    
15. ar = Range("c7:c" & [c65536].End(3).Row).Value
    
16. ReDim b(1 To UBound(ar), 1 To 5)
    
17. For i = 1 To UBound(ar)
    
18.     k = ar(i, 1): t = d(k)
    
19.     b(i, t) = k
    
20.     If rng Is Nothing Then
    
21.         Set rng = Cells(i + 6, t + 10)
    
22.     Else
    
23.         Set rng = Union(rng, Cells(i + 6, t + 10))
    
24.     End If
    
25. Next
    
26. [k7].Resize(i - 1, 5).Clear
    
27. [k7].Resize(i - 1, 5) = b
    
28. [k7].Resize(i - 1, 5).Borders.LineStyle = xlDouble
    
29. rng.Interior.Color = vbYellow
    
30. rng.Font.Bold = 1
    
31. End Sub

复制代码