有關行列轉置問題

活在理想的世界

jacky007x 发表于 2017-9-21 21:03
好的，沒問題，再有勞您了，我也還在找相關的資料!!

是不是把所有跟“服务类别”相关的“加工内容”分类去重？

uynayna

第二问

1. Sub Test()
   
2.     Dim d As Object, d1, ar, br, k, i&, m%, n%
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     ar = Sheets("sheet1").UsedRange
   
6.     For i = 2 To UBound(ar)
   
7.         If Not d.Exists(ar(i, 5)) Then
   
8.             d(ar(i, 5)) = ""
   
9.         End If
   
10.     Next
    
11.     ReDim br(1 To d.Count, 1 To UBound(ar))
    
12.     For Each aa In d.keys
    
13.         k = k + 1
    
14.         n = 1
    
15.         For i = 2 To UBound(ar)
    
16.             For j = 6 To 12
    
17.                 If ar(i, 5) = aa Then
    
18.                     If Not d1.Exists(aa & ar(i, j)) Then
    
19.                         d1(aa & ar(i, j)) = ""
    
20.                          If ar(i, j) <> "" Then
    
21.                          n = n + 1
    
22.                         br(k, 1) = ar(i, 5)
    
23.                         br(k, n) = ar(i, j)
    
24.                         End If
    
25.                     End If
    
26.                 End If
    
27.             Next
    
28.         Next
    
29.     Next
    
30.     Sheets("sheet1").Range("aa9").Resize(d.Count, UBound(br, 2)) = br
    
31. End Sub
    

复制代码

活在理想的世界

1111111111111111111111111111111111111111111111

jacky007x

uynayna 发表于 2017-9-21 21:31
第二问

uynayna大神真是太強大了，晚點補上鮮花!!

jacky007x

活在理想的世界 发表于 2017-9-22 07:50
1111111111111111111111111111111111111111111111

Hansen大神真是太強大了，晚點補上鮮花!!!