Hsieh

¦^´_ 3# adam2010


    ±Æµ{À³¸Ó·|¦Ò¼{¨C§å³Ì¤j¶q©Î³Ì¤p¶q¬O¦h¤Ö?
´N¥H1/1ªº250¨Ó»¡¡A¬°¦ó­n±Æ¦¨2§å100¡B200
¤£¯à±Æ100¡B150¶Ü?
µ{¦¡³]­p¥²¶·¦Ò¼{¨ì¾ãÅéÅÞ¿è¬Û³q¡A­Y¦³¯S§O³W©w´N¥²¶·¸Ô²Ó»¡©ú¦UºØ­­¨î±ø¥ó
¤~¯à¾ã²z¥X¦@¦P¯S©Ê¨Ó¸Ñ¨M°ÝÃD

Hsieh

¦^´_ 8# adam2010
Sheets("¥æ´Á")ªºDÄæ¼Æ¶q¬O¤H¤u¥ý¿é¤J¦nªº¶Ü?
¸Õ¸Õ¬Ý

1. Sub ex()
   
2. Dim Ar(), Ay(), C As Range, Rng As Range
   
3. Set d = CreateObject("Scripting.Dictionary") '¼Æ¶q
   
4. Set d1 = CreateObject("Scripting.Dictionary") '¤é´Á
   
5. With Sheets("¥X³f¤é")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown)) 'ª«®Æ
   
7.   Set Rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) '­q³f
   
8.   ReDim Preserve Ar(s) '¼Æ¶q
   
9.   ReDim Preserve Ay(s) '¤é´Á
   
10.   Ar(s) = 0
    
11.   Ay(s) = .Cells(1, Rng.Column)
    
12.   s = s + 1
    
13.      For Each C In Rng
    
14.         cnt = cnt + C
    
15.         ReDim Preserve Ar(s)
    
16.         ReDim Preserve Ay(s)
    
17.         Ar(s) = cnt
    
18.         Ay(s) = .Cells(1, C.Column).Value
    
19.         s = s + 1
    
20.      Next
    
21.      d(a.Value) = Ar
    
22.      d1(a.Value) = Ay
    
23.      Erase Ar: Erase Ay: s = 0: cnt = 0
    
24. Next
    
25. End With
    
26. With Sheets("¥æ´Á")
    
27.   For Each a In .Range(.[A2], .[A2].End(xlDown))
    
28.      cnt = cnt + a.Offset(, 3)
    
29.      If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then _
    
30.      a.Offset(, 4) = Application.Lookup(cnt, d(a.Value), d1(a.Value)) _
    
31.      Else a.Offset(, 4) = "NA"
    
32.      If a <> a.Offset(1) Then cnt = 0
    
33.   Next
    
34. End With
    
35. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 10# adam2010
Lookup¨ç¼Æ¨Ã¤£¾A¥Î

1. Sub ex()
   
2. Dim Ar(), Ay(), C As Range, rng As Range
   
3. Set d = CreateObject("Scripting.Dictionary") '¼Æ¶q
   
4. Set d1 = CreateObject("Scripting.Dictionary") '¤é´Á
   
5. With Sheets("¥X³f¤é")
   
6. For Each a In .Range(.[A2], .[A2].End(xlDown)) 'ª«®Æ
   
7.   Set rng = a.EntireRow.SpecialCells(xlCellTypeConstants, xlNumbers) 'À³¥æ³f¼Æ¶q
   
8.      For Each C In rng
   
9.         cnt = cnt + C
   
10.         ReDim Preserve Ar(s)
    
11.         ReDim Preserve Ay(s)
    
12.         Ar(s) = cnt
    
13.         Ay(s) = .Cells(1, C.Column).Value
    
14.         s = s + 1
    
15.      Next
    
16.      d(a.Value) = Ar
    
17.      d1(a.Value) = Ay
    
18.      Erase Ar: Erase Ay: s = 0: cnt = 0
    
19. Next
    
20. End With
    
21. With Sheets("¥æ´Á")
    
22.   For Each a In .Range(.[A2], .[A2].End(xlDown))
    
23.      cnt = cnt + a.Offset(, 3)
    
24.      If cnt <= Application.Max(d(a.Value)) Or cnt - a.Offset(, 3) < Application.Max(d(a.Value)) Then
    
25.      i = 0
    
26.      Do Until cnt - a.Offset(, 3) < d(a.Value)(i) Or i = UBound(d(a.Value))  '§ä¨ì°}¦C¤¤¤ñ¤w¥æ³f¼Æ¶qÁÙ¤jªºÀ³¥æ³f¼Æ¶q
    
27.      n = d(a.Value)(i)
    
28.        i = i + 1
    
29.      Loop
    
30.      a.Offset(, 4) = d1(a.Value)(i)
    
31.      Else
    
32.      a.Offset(, 4) = "NA"
    
33.      End If
    
34.      If a <> a.Offset(1) Then cnt = 0
    
35.   Next
    
36. End With
    
37. End Sub

½Æ»s¥N½X