標題: 有關sheet1拆開及複製資料至sheet2 [打印本頁]

---

作者: pesi2884    時間: 2010-5-24 22:00     標題: 有關sheet1拆開及複製資料至sheet2

因為工作上需要分析龐大的資料，麻煩好心的前輩幫我解一下，小弟感激不盡，謝謝呀!
問題說明:在sheet1內 A欄依"、"拆成數筆資料
                 ，BCJKL欄則一樣複製
                 ，DEFGHI欄中的"1"僅會複製給第1筆資料，"-"則給拆開的第2筆資料、第3筆資料、第4筆資料..
             ，MNOP欄中則依序放入拆開名稱資料
                 ，希望達到成果如"sheet2"內容

---

作者: Hsieh    時間: 2010-5-24 22:43

回復 1# pesi2884

1. Sub Ex()
   
2. Dim Ay(16), Ary()
   
3. With Sheet1
   
4. For Each a In .Range(.[A2], .[A65536].End(xlUp))
   
5. Ar = Split(a, "、")
   
6. For i = 0 To UBound(Ar)
   
7. Ay(0) = Ar(i)
   
8.    For j = 1 To 11
   
9.       Ay(j) = a.Offset(, j).Value
   
10.       If i > 0 And Ay(j) = 1 Then Ay(j) = "-"
    
11.    Next
    
12.    x = 0
    
13.    For k = 0 To UBound(Ar)
    
14.       If k <> i Then Ay(12 + x) = Ar(k): x = x + 1
    
15.    Next
    
16.    ReDim Preserve Ary(s)
    
17.    Ary(s) = Ay
    
18.    s = s + 1
    
19.    Erase Ay
    
20. Next
    
21. Next
    
22. End With
    
23. Sheet2.[A2:P65536] = ""
    
24. Sheet2.[A2].Resize(s, 16) = Application.Transpose(Application.Transpose(Ary))
    
25. End Sub

複製代碼

---

作者: pesi2884    時間: 2010-5-24 22:59

Hsieh前輩:
這個問題我想了好久，我也嘗試自己寫了好久時間，
分了很多段程式寫在按鈕內，需要分段完成，
想不到你一個程式一下下就解決了!
我run了之後沒有問題，
比我自己寫的程式也又臭又長，好太多了，
希望有一天可以學到你一半的境界就好啦。
真的很謝謝你!

---

作者: Hsieh    時間: 2010-6-19 16:52

回復 4# sping


    短不一定就是好
能夠完成需求的答案都是好答案
分段執行有分段執行的好處
容易除錯及修正程式
程式短可能用到的函數多執行效率不一定比較好
而且如果沒有完全了解程式的意思
以後要修改可能會造成很大的困難
所以不必羨慕程式簡短
學習到內容含意才是重要的

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)