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

[µo°Ý] excel²Î­p¤½¦¡¹Bºâ¹L¤[°ÝÃD

¥»©«³Ì«á¥Ñ n7822123 ©ó 2018-11-24 02:53 ½s¿è

¦^´_ 1# msmplay

¬Ý§Aªº¤½¦¡¡A§AÀ³¸Ó¥u¬O·Q§â²Å¦X¦UºØ±ø¥óªº³¡¤À°µ¥[Á`¦Ó¤w¡A

­è­è§â§AªºÀÉ®×¥t¦s¦¨.xls¡A¦ý¬O¥u¦³256Äd¡A§Aªº¼Æ¾Ú¨Ó·½³Q±j­¢¸y±Ù@@¡A¤½¦¡¤]¿ù»~¤F

¥ýªþ¤W¨Ó¡AVBA¬O°µ±o¨ìªº¡AÁöµM§Aªº±ø¥ó¦³ÂI¦h~~~©ú¤Ñ¿ïÁ|­n¥ý¨ÓºÎ¤F¡A¦pªG¨S¤HÀ°§A¡A§Ú¥i¥H¸Õ¬Ý¬Ý(§Ú·sª©Excel)

test+.rar (254.89 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2018-11-24 18:34 ½s¿è

¦^´_ 3# n7822123


«ö¤U²Î­p«ö¶s§Y¥i¡A§Úªº¹q¸£³t«×´X¬íÄÁ§Y¥i§¹¦¨


Sub ²Î­p()
Dim Arr, °Ï­º¦C, °Ï¦C¼Æ, d As Object
Dim «¬¸¹$, ¤é´Á$, ©±¦W$, Ãþ«¬$, Str$, °Ï­º¦C¦ê$, °Ï¦C¼Æ¦ê$
Dim ¤é´Á°_&, ¤é´Á²×&, i%, R%, C%, Rn%, Cn%, °Ï¼Æ%
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
¤é´Á°_ = [²Î­p!D1]: ¤é´Á²× = [²Î­p!F1]
Ãþ«¬ = [²Î­p!H1]
'====¿é¤J¸ê®Æ¨ì¦r¨å¡A¦r¨åªºKey¨Ì©±¦W¡B«¬¸¹°µ°Ï¤À====
'==========¨ÌÃþ«¬°µ¿z¿ï¡A¨Ã¨Ì¤é´Á¥[Á`==========
Sheets("¼Æ¾Ú¨Ó·½").Activate
Arr = Range([C4], Cells(Rows.Count, 394).End(xlUp))
Rn = UBound(Arr): Cn = UBound(Arr, 2) - 1
For R = 3 To Rn: For C = 2 To Cn
  ©±¦W = Arr(1, C): «¬¸¹ = Arr(R, 1)
  ¤é´Á = Arr(R, 392): Str = ©±¦W & "," & «¬¸¹
  If Arr(2, C) = Ãþ«¬ And ¤é´Á >= ¤é´Á°_ And ¤é´Á <= ¤é´Á²× Then d(Str) = d(Str) + Arr(R, C)
Next: Next
'============¿é¥X¦r¨å¸ê®Æ¨ì²Î­p¤u§@ªí============
Sheets("²Î­p").Activate
Rn = Cells(Rows.Count, 2).End(xlUp).Row
For R = 1 To Rn    '¥ý§PÂ_¥X¦U¤p°Ï(¦X¨ÖÀx¦s®æ)ªº­º¦C»P¦C¼Æ
  If Cells(R, 2) Like "*°Ï" Then
    °Ï­º¦C¦ê = °Ï­º¦C¦ê & "," & R
    °Ï¦C¼Æ¦ê = °Ï¦C¼Æ¦ê & "," & Cells(R, 2).MergeArea.Rows.Count - 1  '¦©±¼¤p­p¦C
    °Ï¼Æ = °Ï¼Æ + 1
  End If
Next R
°Ï­º¦C = Split(°Ï­º¦C¦ê, ","): °Ï¦C¼Æ = Split(°Ï¦C¼Æ¦ê, ",")  '©î¦¨°}¦C
Cn = [E4].End(2).Column - 4   '²Î­pªí­n¿é¤J¸ê®ÆªºÄæ¼Æ
For i = 1 To °Ï¼Æ  '±q¦r¨å¤ñ¹ïkey¨Ã¿é¥X¸ê®Æ¨ì¬ÛÀ³Äæ¦C
  Arr = Cells(°Ï­º¦C(i), 5).Resize(°Ï¦C¼Æ(i), Cn)
  For C = 1 To Cn: For R = 1 To °Ï¦C¼Æ(i)
    ©±¦W = Cells(R + 4, 4): «¬¸¹ = Cells(4, C + 4)
    Arr(R, C) = d(©±¦W & "," & «¬¸¹)
  Next R: Next C
  Cells(°Ï­º¦C(i), 5).Resize(°Ï¦C¼Æ(i), Cn) = Arr
  Cells(Val(°Ï­º¦C(i)) + Val(°Ï¦C¼Æ(i)), 5).Resize(, Cn) = "=sum(R[-" & °Ï¦C¼Æ(i) & "]C:R[-1]C)"   '¤p­p¦C¤½¦¡(Sum.....)
Next i
End Sub

test-1124.rar (914.48 KB)
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

        ÀR«ä¦Û¦b : ¹ï¤÷¥À­nª¾®¦¡A·P®¦¡B³ø®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD