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

[µo°Ý] Q15:Q26¬°E2©Ò¿é¤J¤é´Á¥H«eªºÁ`©M(¤w¸Ñ¨M)

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-8-31 00:14 ½s¿è

¦^´_ 13# olisun
²Ö­p°Ï¶ô­pºâ
  1. Sub ²Ö­p()
  2. Dim d as Object,sh as WorkSheet,r as Long,a as Range,w As String,dt As Date,b As Range,at As String
  3. Set d = CreateObject("Scripting.Dictionary") '«Ø¥ß¦r¨åª«¥ó
  4. For Each sh In Sheets(Array("¬£§¨³ø«Å¶Ç¨®", "NP¡BCF")) '¦b2­Ó¸ê®Æ¤u§@ªí´`Àô
  5. With sh
  6. r = 3
  7. dt = .Cells(r, 1) '¸ê®Æ¤u§@ªíAÄæªº¤é´Á
  8.   Do Until dt > Sheets("¤é³øªí").[E2]  '·í¤é´Á¶W¹L´N¸õÂ÷°j°é
  9.      For Each a In .Range(.[B2], .[B2].End(xlToRight))  '¸ê®Æ¤u§@ªí²Ä2¦C°µ´`Àô
  10.         w = a.Offset(-1, 0).MergeArea.Cells(1, 1)  '²Ä¤@¦C¹ïÀ³¨ìªº¤º®e¦]¬°¦³¦X¨ÖÀx¦s®æ©Ò¥H¨ú¦X¨Ö½d³ò²Ä¤@®æªº­È¼g¤JÅܼÆ
  11.         d(w & a) = d(w & a) + .Cells(r, a.Column).Value  '¥HºØÃþ¸ò°Ï°ì¦r¦ê°µ¯Á¤ÞÀx¦s¹ïÀ³¨ìªº­È
  12.      Next
  13.      r = r + 1
  14.      dt = .Cells(r, 1)  '¼g¤J¤U¤@­Ó¤é´Á
  15.   Loop
  16.   End With
  17. Next
  18. With Sheets("¤é³øªí")
  19. For Each a In .[B15:B26]
  20. at = a
  21.    For Each b In .[P14:U14]
  22.       If b.Column > 18 Then at = ""  '¦]¬°18Äæ¥H«á¨S¦³¦a°Ï©Ò¥H­nÅý¦a°ÏÅܼÆÅܪÅ
  23.       .Cells(a.Row, b.Column) = d(b & at)  '¼g¦^¤é³øªí
  24.    Next
  25. Next
  26. End With
  27. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¥»©«³Ì«á¥Ñ Hsieh ©ó 2010-8-30 23:31 ½s¿è

¦^´_ 15# olisun
¦pªG§A±Ô­z¨S¿ù¨º´N¬Oµ§»~¦h¤@¦ær=r+1(¤w­×¥¿)
¦pªG¬O¦P¤@©P²Ö­p
  1. Sub ¦P©P²Ö­p()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each sh In Sheets(Array("¬£§¨³ø«Å¶Ç¨®", "NP¡BCF"))
  4. With sh
  5. r = 3
  6.   Do Until .Cells(r, 1) = "" 'Sheets("¤é³øªí").[E2]
  7.      dt = .Cells(r, 1)
  8.      If Year(dt) = Year(Sheets("¤é³øªí").[E2]) And Application.WeekNum(dt, 2) = Application.WeekNum(Sheets("¤é³øªí").[E2], 2) Then
  9.      For Each a In .Range(.[B2], .[B2].End(xlToRight))
  10.         w = a.Offset(-1, 0).MergeArea.Cells(1, 1)
  11.         d(w & a) = d(w & a) + .Cells(r, a.Column).Value
  12.      Next
  13.      End If
  14.      r = r + 1
  15.      dt = .Cells(r, 1)
  16.   Loop
  17.   End With
  18. Next
  19. With Sheets("¤é³øªí")
  20. For Each a In .[B15:B26]
  21. at = a
  22.    For Each b In .[P14:U14]
  23.       If b.Column > 18 Then at = ""
  24.       .Cells(a.Row, b.Column) = d(b & at)
  25.    Next
  26. Next
  27. End With
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

        ÀR«ä¦Û¦b : ¡i®É¤é²öªÅ¹L¡j¤@­Ó¤H¦b¥@¶¡°µ¤F¦h¤Ö¨Æ¡A´Nµ¥©ó¹Ø©R¦³¦hªø¡C¦]¦¹¥²¶·»P®É¶¡Ävª§¡A¤Á²ö¨Ï®É¤éªÅ¹L¡C
ªð¦^¦Cªí ¤W¤@¥DÃD