ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ½Ð¤j®aÀ°§Ú¬Ý³oµÛ¸ê®Æ½s±Æ¶¶§Çªº°ÝÃD

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-12-15 15:28 ½s¿è

¦^´_ 3# sandra_wang
Ãö©óL2¬°3ªº½s½X¬O§_­n¦³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
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ÁÀ¨¥¹³¤@¦·²±¶}ªºÂAªá¡A¥~ªí¬üÄR¡A¥Í©Rµu¼È¡C
ªð¦^¦Cªí ¤W¤@¥DÃD