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

[µo°Ý] VBA¤¤ªº¨ç¼Æ¦¡ ¨ú¥N

Sub ¤½¦¡_01()
Dim xR As Range, xH As Range, xA As Range, C%, N&
Set xR = [C5] '²Ä¤@°Ï©w¦ì®æ
C = Application.Match("¦X­p", Rows(4), 0) - xR.Column  'Äæ¦ì¼Æ
Set xA = xR.Resize(7, C) '²Ä¤@°Ï(¤£§t¦X­pÄæ)
Application.ScreenUpdating = False
xA = "=IF(C4=0,"""",INT(C4/$C$3)&""½c""&TEXT(MOD(C4,$C$3),""+0;;;""))"
xA.Rows(1) = "=SUMPRODUCT((­¸¤ñ!$F$4:$F$70=$B$3)*(­¸¤ñ!$AP$3:$BH$3=C4)*(­¸¤ñ!$AP$4:$BH$70))"
xA.Rows(3) = "=SUMPRODUCT((­¸¤ñ!$F$4:$F$70=$B$3)*(­¸¤ñ!$BJ$3:$CB$3=C4)*(­¸¤ñ!$BJ$4:$CB$70))"
xA.Rows(5) = "=SUMPRODUCT((­¸¤ñ!$F$4:$F$70=$B$3)*(­¸¤ñ!$CD$3:$CV$3=C4)*(­¸¤ñ!$CD$4:$CV$70))"
xA.Rows(6) = "=SUMPRODUCT((­¸¤ñ!$F$4:$F$70=$B$3)*(­¸¤ñ!$CX$3:$DP$3=C4)*(­¸¤ñ!$CX$4:$DP$70))"
xR(1, C + 1).Resize(7) = "=IF($B5=""½c+²~"","""",SUM(" & xA.Rows(1).Address(0, 0) & "))" '¦X­pÄæ
'-----------------------------------------------
Set xA = xR.Resize(7, C + 1) '²Ä¤@°Ï(§t¦X­pÄæ)
Do
    N = N + 1: Set xH = xR(N * 9 + 1, 1)
    If xH(1, 0) <> "­qÁʼÆ" Then Exit Do
    With xH.Resize(7, C + 1)
         xA.Copy .Cells
         .Value = .Value
    End With
Loop
xA.Value = xA.Value
End Sub

Xl0000048.rar (35.95 KB)

======================================

TOP

        ÀR«ä¦Û¦b : ¤Hªº¤ß¦a¬O¤@²¥¥Ð¡A¤g¦a¨S¦³¼½¤U¦nºØ¤l¡A¤]ªø¤£¥X¦nªºªG¹ê¡C -
ªð¦^¦Cªí ¤W¤@¥DÃD