Hsieh

¦^´_ 1# missbb

ªí1ªº¸ê®Æ¤¤¡A®É¬q¥Î°Ï¬q¤è¦¡°O¿ý¡A¤£¦X¥G¸ê®Æ®w·Ç«h
­n°µ¤À¤ë¬d¸ß¬O¤£¯à¥¿½T±o¨ì

Hsieh

¦^´_ 1# missbb
§A¬O­n¾ã²z¸ê®Æ¦¨¬°¸ê®Æ®w«¬ºA§a

1. Sub ex()
   
2. Dim OT$, Ary(), r&, y$, a$, i%, s&
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. Set dic1 = CreateObject("Scripting.Dictionary")
   
5. r = 2
   
6. With Sheets(1)
   
7. Do Until .Cells(r, 2) = ""
   
8. OT = IIf(.Cells(r, 1) <> "", .Cells(r, 1), OT)
   
9. y = Split(.Cells(r, 2), "¦~")(0)
   
10. a = Split(.Cells(r, 2), "¦~")(1)
    
11.    If InStr(a, "-") > 0 Then
    
12.    ar = Split(a, "-")
    
13.    For i = Val(ar(0)) To Val(ar(1))
    
14.       dic(y & "¦~" & i & "¤ë" & OT) = .Cells(r, 3)
    
15.       dic1(y & "¦~" & i & "¤ë") = ""
    
16.    Next
    
17.    Else
    
18.    dic(y & "¦~" & a & OT) = .Cells(r, 3)
    
19.    n = .Cells(r, 2)
    
20.    dic1(.Cells(r, 2) & "") = ""
    
21.    End If
    
22.    r = r + 1
    
23. Loop
    
24. ay = Array("®É¬q", "Á~ª÷", "¥[¯Z")
    
25. ReDim Preserve Ary(s)
    
26. Ary(s) = ay
    
27. s = s + 1
    
28. For Each ky In dic1.keys
    
29. ReDim Preserve Ary(s)
    
30. Ary(s) = Array(ky, dic(ky & ay(1)), dic(ky & ay(2)))
    
31. s = s + 1
    
32. Next
    
33. With Sheets(2)
    
34. .Columns("A:C") = ""
    
35. .[A1].Resize(s, 3) = Application.Transpose(Application.Transpose(Ary))
    
36. End With
    
37. End With
    
38. End Sub

½Æ»s¥N½X