stillfish00

¦^´_ 8# adam2010

1. Sub Test()
   
2. Dim rng As Range
   
3. Dim s1 As Long, s2 As Long
   
4. Dim cindex As Long
   
5. 
   
6. With Sheets("¥X³f¤é")
   
7.     Set rng = .Range(.[A1], .[A1].End(xlToRight).End(xlDown).Offset(, -1))  '[¥X³f¤é]¸ê®Æ½d³ò
   
8. End With
   
9. 
   
10. For Each c In Sheets("¥æ´Á").Range("E2:E" & Sheets("¥æ´Á").[A1].End(xlDown).Row)   '[¥æ´Á]¸ê®Æ¶ñ¤J½d³ò
    
11.     If c.Offset(, -4).Value <> c.Offset(-1, -4).Value Then
    
12.         cindex = 1
    
13.         s1 = 0  '²Ö¿n¦Ü«e¤@§å¼Æ¶q
    
14.         s2 = 0  '²Ö¿n¥X³f»Ý¨D¼Æ¶q
    
15.     Else
    
16.         s1 = s1 + c.Offset(-1, -1).Value
    
17.     End If
    
18.    
    
19.     Do While s2 <= s1
    
20.         cindex = cindex + 1
    
21.         If Application.IsError(Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)) Then
    
22.             Exit Do
    
23.         Else
    
24.             s2 = s2 + Application.VLookup(c.Offset(, -4).Value, rng, cindex, False)
    
25.         End If
    
26.     Loop
    
27.    
    
28.     If s2 <= s1 Then
    
29.         c.Value = "NA"
    
30.     Else
    
31.         c.Value = rng.Cells(1, cindex).Value
    
32.     End If
    
33. Next
    
34. Set rng = Nothing
    
35. End Sub

½Æ»s¥N½X

adam2010

·PÁÂDino¤j,Hsieh¤j¥H¤Îstillfish00¤jªº¨ó§U¡A
´ú¸ÕµL»~¡A¸Ñ¨M§Úªñ´X¶gªº§xÂZ¡A¤Ó·P°Ê¤F¡AÁÂÁ¡I

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

adam2010

Dear  Hsieh¤j¡A·PÁ±zªº¦^ÂСA´ú¸ÕµL»~
¥Ø«e´ú¸Õ±z¸òstillfish00©Ò´£¨Ñªº§¡¥¿½T¡A§Ú¦A¬ã¨s¬Ý¬Ý¨âªÌªº®t²§¡AÁÂÁ¡I