Hsieh

回復 3# sandra_wang
關於L2為3的編碼是否要有3個MAX
試試看

1. Sub Ex()
   
2. Dim A As Range, MyStr$
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. k = 182
   
7. With Sheets("DATABASE")
   
8.     Do Until .Cells(1, k) = ""
   
9.     Set A = .Cells(1, k)
   
10.        d(A.Value) = A.Resize(5, 1).Value
    
11.        k = k + 1
    
12.     Loop
    
13. End With
    
14. With Sheets("OUTPUT")
    
15. k = 9
    
16. Do Until .Cells(1, k) = ""
    
17. MyStr = Replace(.Cells(1, k), "_", "")
    
18.    Set A = .Cells(2, k).Resize(3, 1)
    
19.    s = 1
    
20.    For j = 1 To 3
    
21.    mykey = IIf(j = 1, "Max_", IIf(j = 2, "Min_", "Middle_"))
    
22.       For i = 1 To A(j)
    
23.          d1(mykey) = d1(mykey) + 1
    
24.          d2(MyStr & "_" & s) = d(mykey & d1(mykey))
    
25.          s = s + 1
    
26.       Next
    
27.    Next
    
28.    k = k + 1
    
29. Loop
    
30. k = 3
    
31. For Each ky In d2.keys
    
32. .Cells(6, k) = ky
    
33. .Cells(70, k).Resize(5, 1) = d2(ky)
    
34. k = k + 1
    
35. Next
    
36. End With
    
37. End Sub

複製代碼