有關行列轉置問題

jacky007x

活在理想的世界 发表于 2017-9-21 20:17

Hansen老師~看到你出現我都快哭了
我剛剛試了一下，結果熱處理多了一行出來，可否再勞煩老師修改一下
感謝~~

jiangxiaoyun

TEST.zip (24.75 KB, 下载次数: 0)

2017-9-21 20:24 上传

点击文件名下载附件

自行补充一个clearcontents的代码

活在理想的世界

jacky007x 发表于 2017-9-21 20:23
Hansen老師~看到你出現我都快哭了
我剛剛試了一下，結果熱處理多了一行出來，可否再勞煩老師修改一下
...

多出一行是你本身数据的问题，因为热处理是简体和正体个一个，所以会出现多一行的情况。

转换一下字体就行。

jacky007x

活在理想的世界 发表于 2017-9-21 20:28
多出一行是你本身数据的问题，因为热处理是简体和正体个一个，所以会出现多一行的情况。

转换一下字体 ...

好的~~感謝您!!!

jacky007x

jiangxiaoyun 发表于 2017-9-21 20:25
自行补充一个clearcontents的代码

大神~~今天花兒沒了，明天補上，感謝您熱心幫忙，我會好好惡補你提供的資料!!

paciguard

好了，

1. Sub 按钮4_Click()
   
2. Dim a, b(), c&, da, db
   
3. Set da = CreateObject("Scripting.Dictionary")
   
4. 
   
5. a = Range("A1").CurrentRegion
   
6. For i = 2 To UBound(a)
   
7. If Not da.exists(a(i, 2)) Then
   
8. da.Add a(i, 2), a(i, 5)
   
9. ElseIf da.exists(a(i, 2)) Then
   
10. da(a(i, 2)) = da(a(i, 2)) & "," & a(i, 5)
    
11. End If
    
12. Next i
    
13. 
    
14. 
    
15. For j = 0 To UBound(da.items())
    
16. Dim str
    
17. str = Split(da.items()(j), ",")
    
18. Set db = CreateObject("Scripting.Dictionary")
    
19. If c = 0 Then
    
20. c = UBound(str)
    
21. Else
    
22. c = WorksheetFunction.Max(c, UBound(str))
    
23. End If
    
24. ReDim Preserve b(0 To UBound(da.items()), 0 To c)
    
25. b(j, 0) = da.keys()(j)
    
26. Dim ii&
    
27. ii = 1
    
28. For k = 0 To UBound(str)
    
29. If Not db.exists(str(k)) And str(k) <> "" Then
    
30. db.Add str(k), ""
    
31. b(j, ii) = str(k)
    
32. ii = ii + 1
    
33. End If
    
34. Next k
    
35. str = ""
    
36. Set db = Nothing
    
37. Next j
    
38. 
    
39. Range("P1").Resize(UBound(b), UBound(b, 2)) = b
    
40. 
    
41. End Sub
    

复制代码

jacky007x

活在理想的世界 发表于 2017-9-21 20:28
多出一行是你本身数据的问题，因为热处理是简体和正体个一个，所以会出现多一行的情况。

转换一下字体 ...

Hansen老師，還有個延伸問題要請教您
可否再耽誤您一點時間幫我看一下附件，感謝了!!

jacky007x

paciguard 发表于 2017-9-21 20:41
好了，

感謝路大神，花朵明天再為您奉上..今天的花朵用光了..
感激不盡!!!!

活在理想的世界

jacky007x 发表于 2017-9-21 20:47
Hansen老師，還有個延伸問題要請教您
可否再耽誤您一點時間幫我看一下附件，感謝了!!

明天吧，但我不一定能解决的了。

jacky007x

活在理想的世界 发表于 2017-9-21 21:02
明天吧，但我不一定能解决的了。

好的，沒問題，再有勞您了，我也還在找相關的資料!!