Piny-多條件判斷(VBA)

piny

感謝藍老師協助，考量閱讀便利性，另開新帖求問。

第一問連結
http://club.excelhome.net/thread-739394-1-1.html

第二問連結
http://club.excelhome.net/thread-742825-1-1.html

問題一：利用VBA寫出下述公式，請與基準分析寫在同一個按鈕中，參考模擬結果可看「參考」活頁

2001 AFA
DR18=CX18
公式說明：2001 AFA就等於2001 FA

2002 AFA~2010 AFA
DS18=IF(DH18,(CX18+CY18)/2,CY18),本式可右拉九列
公式說明：若2001 TA不為0，則2002 AFA就等於2001 FA及2002 FA之平均，否則即等於2002 FA

先說明$L$16:$U$16中之公式
即將顯示包含年份者為1，供EB~EN判斷公式用
以本例，B3及B4分別為2004年及2008年，則L16至U16分別為0, 0, 0, 1, 1, 1, 1, 1, 0, 0，可視此為分析年度
V16係將L至U相加，可視此為分析年度數

WA RD to Sales
EB18=SUM(IF(AZ18:BI18>0,AZ18:BI18,BJ18:BS18)*$L$16:$U$16)/SUM($V18:$AE18*$L$16:$U$16)
公式說明：分析年度之RD除以Sales，取加權（需注意RD判斷方式與其下幾個WA之判斷不太一樣）
分子部分：同年度RD若C大於0，則取其值，否則則取U值，即若AZ~BI大於0，則取AZ~BI，否則則取BJ~BS，之後再乘以L~U，取其和
分母部分：同年度之Sales，即V~AE乘以L~U，取其和

WA OE to Sales
EC18=SUM(AP18:AY18*$L$16:$U$16)/SUM($V18:$AE18*$L$16:$U$16)
公式說明：分析年度之OE除以Sales，取加權
分子部分：同年度之OE，即AP~AY乘以L~U，取其和
分母部分：同年度之Sales，即V~AE乘以L~U，取其和

WA FA to Sales
ED18=SUM(DR18:EA18*$L$16:$U$16)/SUM($V18:$AE18*$L$16:$U$16)
公式說明：分析年度之AFA除以Sales，取加權
分子部分：同年度之AFA，即DR~EA乘以L~U，取其和
分母部分：同年度之Sales，即V~AE乘以L~U，取其和

WA 關係人銷貨 to Sales
EE18=SUM(BT18:CC18*$L$16:$U$16)/SUM($V18:$AE18*$L$16:$U$16)
公式說明：分析年度之RP Sales除以Sales，取加權
分子部分：同年度之RP Sales，即BT~CC乘以L~U，取其和
分母部分：同年度之Sales，即V~AE乘以L~U，取其和

WA 關係人進貨 to COGS
EF18=SUM(CD18:CM18*$L$16:$U$16)/SUM(AF18:AO18*$L$16:$U$16)
公式說明：分析年度之RP Purchase除以COGS，取加權
分子部分：同年度之RP Purchase，即CD~CM乘以L~U，取其和
分母部分：同年度之COGS，即AF~AO乘以L~U，取其和

缺少連續X年財務數字
EH18=IF(($EH17="")+(E18=""),"",IF(SUM((V18:AE18>0)*L$16:U$16+(AF18:AO18>0)*L$16:U$16+(AP18:AY18>0)*L$16:U$16)=3*V$16,"接受","拒絕"))
公式說明：分析年度之Sales, COGS, OE是否皆有值
若EH17為空值或E18為空值，則不計算公式，否則則計算(V~AE大於0)乘以L~U+(AF~AO大於0)乘以L~U+(AP~AY大於0)乘以L~U，其和是否為V16之3倍，若是，則傳回接受，否則傳回拒絕

任X年虧損
EI18=IF((EI$17="")+(E18=""),"",IF(EH18="拒絕","拒絕",IF(SUM((CN18:CW18<0)*L$16:U$16)>=EI$16,"拒絕","接受")))
公式說明：分析年度之虧損年度數是否大於等於EI16（EI16公式說明：其實可視為傳回EI17中之國字數字）
注意事項：若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
若EI17為空值或E18為空值，則不計算公式，若EH18為拒絕，則直接傳回拒絕，否則計算(CN~CW小於0)乘以L~U，其和是否大於等於EI16，若是，則傳回拒絕，否則傳回接受

RD to Sales大於（或小於）XX%
EJ18=IF((EJ$17="")+(E18=""),"",IF(OR($EH18:EI18="拒絕"),"拒絕",IF(($C$11<>"")*(EB18<$C$11)+($D$11<>"")*(EB18>$D$11),"拒絕","接受")))
公式說明：若C11有值，則判斷分析年度之WA RD to Sales是否小於C11；若D11有值，則判斷分析年度之WA RD to Sales是否大於D11
注意事項：
若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
C11及D11可能同時有值，也可能同時沒有值
若EJ17為空值或E18為空值，則不計算公式，若EH或EI為拒絕，則直接傳回拒絕，否則計算公式說明部分，若是，則傳回拒絕，否則傳回接受

OE to Sales大於（或小於）XX%
EK18=IF((EK$17="")+(E18=""),"",IF(OR($EH18:EJ18="拒絕"),"拒絕",IF(($C$12<>"")*(EC18<$C$12)+($D$12<>"")*(EC18>$D$12),"拒絕","接受")))
公式說明：若C12有值，則判斷分析年度之WA OE to Sales是否小於C12；若D12有值，則判斷分析年度之WA OE to Sales是否大於D12
注意事項：
若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
C12及D12可能同時有值，也可能同時沒有值
若EK17為空值或E18為空值，則不計算公式，若EH或EI或EJ為拒絕，則直接傳回拒絕，否則計算公式說明部分，若是，則傳回拒絕，否則傳回接受

FA to Sales大於（或小於）XX%
EL18=IF((EL$17="")+(E18=""),"",IF(OR($EH18:EK18="拒絕"),"拒絕",IF(($C$13<>"")*(ED18<$C$13)+($D$13<>"")*(ED18>$D$13),"拒絕","接受")))
公式說明：若C13有值，則判斷分析年度之WA AFA to Sales是否小於C13；若D13有值，則判斷分析年度之WA AFA to Sales是否大於D13
注意事項：
若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
C13及D13可能同時有值，也可能同時沒有值
若EL17為空值或E18為空值，則不計算公式，若EH或EI或EJ或EK為拒絕，則直接傳回拒絕，否則計算公式說明部分，若是，則傳回拒絕，否則傳回接受

關係人銷貨 to Sales大於（或小於）XX%
EM18=IF((EM$17="")+(E18=""),"",IF(OR($EH18:EL18="拒絕"),"拒絕",IF(($C$14<>"")*(EE18<$C$14)+($D$14<>"")*(EE18>$D$14),"拒絕","接受")))
公式說明：若C14有值，則判斷分析年度之WA RP Sales to Sales是否小於C14；若D14有值，則判斷分析年度之WA RP Sales to Sales是否大於D14
注意事項：
若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
C14及D14可能同時有值，也可能同時沒有值
若EM17為空值或E18為空值，則不計算公式，若EH或EI或EJ或EK或EL為拒絕，則直接傳回拒絕，否則計算公式說明部分，若是，則傳回拒絕，否則傳回接受

關係人進貨 to COGS大於（或小於）XX%
EN18=IF((EN$17="")+(E18=""),"",IF(OR($EH18:EM18="拒絕"),"拒絕",IF(($C$15<>"")*(EF18<$C$15)+($D$15<>"")*(EF18>$D$15),"拒絕","接受")))
公式說明：若C15有值，則判斷分析年度之WA RP Purchase to COGS是否小於C15；若D15有值，則判斷分析年度之WA RP Purchase to COGS是否大於D15
注意事項：
若前面判斷有拒絕，則直接傳回拒絕（有一個拒絕，其後都不用再判斷了）
C15及D15可能同時有值，也可能同時沒有值
若EN17為空值或E18為空值，則不計算公式，若EH或EI或EJ或EK或EL或EM為拒絕，則直接傳回拒絕，否則計算公式說明部分，若是，則傳回拒絕，否則傳回接受

[ 本帖最后由 piny 于 2011-7-22 10:31 编辑 ]

蓝桥玄霜

2002 AFA~2010 AFA
DS18=IF(DI18,(CZ18+DA18)/2,DA18),本式可右拉九列
公式說明：若2002 TA不為0，則2002 AFA就等於2001 FA及2002 FA之平均，否則即等於2002 FA
但是这里公式的内容是：若2002 TA不為0，則2002 AFA就等於2003 FA及2004 FA之平均，否則即等於2004 FA?
是不是公式有误？应该是：
DS18=IF(DI18,(CX18+CY18)/2,CY18),

piny

原帖由 蓝桥玄霜 于 2011-7-22 09:42 发表
2002 AFA~2010 AFA
DS18=IF(DI18,(CZ18+DA18)/2,DA18),本式可右拉九列
公式說明：若2002 TA不為0，則2002 AFA就等於2001 FA及2002 FA之平均，否則即等於2002 FA
但是这里公式的内容是：若2002 TA不為0，則2002 AF ...

不好意思 文字說明和公式說明都錯 1樓敍述及附件已改正
DS18=IF(DH18,(CX18+CY18)/2,CY18),本式可右拉九列
公式說明：若2001 TA不為0，則2002 AFA就等於2001 FA及2002 FA之平均，否則即等於2002 FA

蓝桥玄霜

1. Sub afa()
   
2. Dim Arrldq, Myr&, i&, Brrdr, nd, ks, js, n1
   
3. Sheet11.Activate
   
4. ks = Val(Left([b3].Value, 4)) - 1
   
5. js = Val(Left([b4].Value, 4))
   
6. n1 = js - ks + 1
   
7. ReDim nd(1 To n1)
   
8. For i = 1 To n1
   
9.     nd(i) = i + ks - 1
   
10. Next
    
11. 
    
12. Myr = [f65536].End(xlUp).Row
    
13. Arrldq = Range("a18:dq" & Myr)
    
14. Range("dr18:en20000").ClearContents
    
15. Brrdr = Range("dr18:en" & Myr)
    
16. For i = 1 To UBound(Arrldq)
    
17.     sale = 0: rdc = 0: rdu = 0: oe = 0: gxrxh = 0: gxrjh = 0: cogs = 0: m = 0: mm = 0: fa = 0
    
18.     For ii = 1 To n1
    
19.         sale = sale + Arrldq(i, nd(ii) - 2000 + 21)
    
20.         rdc = rdc + Arrldq(i, nd(ii) - 2000 + 51)
    
21.         rdu = rdu + Arrldq(i, nd(ii) - 2000 + 61)
    
22.         oe = oe + Arrldq(i, nd(ii) - 2000 + 41)
    
23.         gxrxh = gxrxh + Arrldq(i, nd(ii) - 2000 + 71)  '关系人销货
    
24.         gxrjh = gxrjh + Arrldq(i, nd(ii) - 2000 + 81)  '关系人进货
    
25.         cogs = cogs + Arrldq(i, nd(ii) - 2000 + 31)  'COGS
    
26.         If Arrldq(i, nd(ii) - 2000 + 21) > 0 Then m = m + 1
    
27.         If Arrldq(i, nd(ii) - 2000 + 31) > 0 Then m = m + 1
    
28.         If Arrldq(i, nd(ii) - 2000 + 41) > 0 Then m = m + 1
    
29.         If Arrldq(i, nd(ii) - 2000 + 91) < 0 Then mm = mm + 1
    
30.     Next
    
31.     For j = 1 To UBound(Brrdr, 2)
    
32.         If j = 1 Then
    
33.             Brrdr(i, j) = Arrldq(i, j + 101) 'DR18=CX18
    
34.         ElseIf j < 11 Then
    
35.             If Arrldq(i, j + 111) <> 0 Then 'DS18
    
36.                 Brrdr(i, j) = (Arrldq(i, j + 101) + Arrldq(i, j + 102)) / 2
    
37.             Else
    
38.                 Brrdr(i, j) = Arrldq(i, j + 102)
    
39.             End If
    
40.         ElseIf j = 11 Then   'EB  WA RD to Sales
    
41.             If sale <> 0 Then
    
42.             If rdc > 0 Then
    
43.                 Brrdr(i, j) = rdc / sale
    
44.             Else
    
45.                 Brrdr(i, j) = rdu / sale
    
46.             End If
    
47.             End If
    
48.         ElseIf j = 12 Then
    
49.             If sale <> 0 Then
    
50.                 Brrdr(i, j) = oe / sale  'EC  WA OE to Sales
    
51.             End If
    
52.         ElseIf j = 13 Then
    
53.             For ii = 1 To n1
    
54.                 fa = fa + Brrdr(i, nd(ii) - 2000)
    
55.             Next
    
56.             If sale <> 0 Then
    
57.                 Brrdr(i, j) = fa / sale  'ED  WA FA to Sales
    
58.             End If
    
59.         ElseIf j = 14 Then
    
60.             If sale <> 0 Then
    
61.                 Brrdr(i, j) = gxrxh / sale  'EE  WA 关系人销货 to Sales
    
62.             End If
    
63.         ElseIf j = 15 Then
    
64.             If cogs <> 0 Then
    
65.                 Brrdr(i, j) = gxrjh / cogs  'EE  WA 关系人进货 to COGS
    
66.             End If
    
67.         ElseIf j = 17 Then
    
68.             If m = 3 * n1 Then
    
69.                 Brrdr(i, j) = "接受"  'EH  缺少连续五年
    
70.             Else
    
71.                 Brrdr(i, j) = "拒绝"
    
72.             End If
    
73.         ElseIf j = 18 Then  'EI  任意X年
    
74.             If Brrdr(i, j - 1) = "拒绝" Then
    
75.                 Brrdr(i, j) = "拒绝"
    
76.             Else
    
77.                 If mm >= [EI16].Value Then
    
78.                     Brrdr(i, j) = "拒绝"
    
79.                 Else
    
80.                     Brrdr(i, j) = "接受"
    
81.                 End If
    
82.             End If
    
83.         ElseIf j = 19 Then  'EJ  RD to Sales
    
84.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Then
    
85.                 Brrdr(i, j) = "拒绝"
    
86.             Else
    
87.                 If [c11] <> "" Then
    
88.                     If Brrdr(i, 11) < [c11].Value Then Brrdr(i, j) = "拒绝": GoTo 100
    
89.                 End If
    
90.                 If [d11] <> "" Then
    
91.                     If Brrdr(i, 11) > [d11].Value Then Brrdr(i, j) = "拒绝": GoTo 100
    
92.                 End If
    
93.                 Brrdr(i, j) = "接受"
    
94.             End If
    
95.         ElseIf j = 20 Then  'EK  OE to Sales
    
96.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Then
    
97.                 Brrdr(i, j) = "拒绝"
    
98.             Else
    
99.                 If [c12] <> "" Then
    
100.                     If Brrdr(i, 12) < [c12].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
101.                 End If
     
102.                 If [d12] <> "" Then
     
103.                     If Brrdr(i, 12) > [d12].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
104.                 End If
     
105.                 Brrdr(i, j) = "接受"
     
106.             End If
     
107.         ElseIf j = 21 Then  'EJ  FA to Sales
     
108.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Then
     
109.                 Brrdr(i, j) = "拒绝"
     
110.             Else
     
111.                 If [c13] <> "" Then
     
112.                     If Brrdr(i, 13) < [c13].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
113.                 End If
     
114.                 If [d13] <> "" Then
     
115.                     If Brrdr(i, 13) > [d13].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
116.                 End If
     
117.                 Brrdr(i, j) = "接受"
     
118.             End If
     
119.         ElseIf j = 22 Then  'EM  关系人销货 to Sales
     
120.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Or Brrdr(i, j - 5) = "拒绝" Then
     
121.                 Brrdr(i, j) = "拒绝"
     
122.             Else
     
123.                 If [c14] <> "" Then
     
124.                     If Brrdr(i, 14) < [c14].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
125.                 End If
     
126.                 If [d14] <> "" Then
     
127.                     If Brrdr(i, 14) > [d14].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
128.                 End If
     
129.                 Brrdr(i, j) = "接受"
     
130.             End If
     
131.         ElseIf j = 23 Then  'EN  关系人销货 to Sales
     
132.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Or Brrdr(i, j - 5) = "拒绝" Or Brrdr(i, j - 6) = "拒绝" Then
     
133.                 Brrdr(i, j) = "拒绝"
     
134.             Else
     
135.                 If [c15] <> "" Then
     
136.                     If Brrdr(i, 15) < [c15].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
137.                 End If
     
138.                 If [d15] <> "" Then
     
139.                     If Brrdr(i, 15) > [d15].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
140.                 End If
     
141.                 Brrdr(i, j) = "接受"
     
142.             End If
     
143.         
     
144.         End If
     
145. 100:
     
146.     Next
     
147. Next
     
148. Range("dr18").Resize(UBound(Brrdr), UBound(Brrdr, 2)) = Brrdr
     
149. [eh13:en15].ClearContents
     
150. Dim jsjj
     
151. jsjj = [eh13:en15]
     
152. For i = 17 To 23
     
153.     For j = 1 To UBound(Brrdr)
     
154.         If Brrdr(j, i) = "接受" Then
     
155.             jsjj(1, i - 16) = jsjj(1, i - 16) + 1
     
156.         Else
     
157.             jsjj(2, i - 16) = jsjj(2, i - 16) + 1
     
158.         End If
     
159.         jsjj(3, i - 16) = jsjj(3, i - 16) + 1
     
160.     Next
     
161. Next
     
162. [eh13].Resize(3, 7) = jsjj
     
163. 
     
164. End Sub
     
165. 
     

复制代码

piny

無法運行 如新附件及附圖 煩請再測試 謝謝

另因簡体字貼至代碼區 一律變為? 故某些公式已修改成英文 方便兩邊測試

[ 本帖最后由 piny 于 2011-7-22 15:06 编辑 ]

蓝桥玄霜

1. Sub afa()
   
2. Dim Arrldq, Myr&, i&, Brrdr, nd, ks, js, n1
   
3. Dim sale,rdc,rdu,oe,gxrxh,gxrjh,fa,cogs,m&,mm&,j&,ii&
   
4. Sheet11.Activate
   
5. ks = Val(Left([b3].Value, 4)) - 1
   
6. js = Val(Left([b4].Value, 4))
   
7. n1 = js - ks + 1
   
8. ReDim nd(1 To n1)
   
9. For i = 1 To n1
   
10.     nd(i) = i + ks - 1
    
11. Next
    
12. 
    
13. Myr = [f65536].End(xlUp).Row
    
14. Arrldq = Range("a18:dq" & Myr)
    
15. Range("dr18:en20000").ClearContents
    
16. Brrdr = Range("dr18:en" & Myr)
    
17. For i = 1 To UBound(Arrldq)
    
18.     sale = 0: rdc = 0: rdu = 0: oe = 0: gxrxh = 0: gxrjh = 0: cogs = 0: m = 0: mm = 0: fa = 0
    
19.     For ii = 1 To n1
    
20.         sale = sale + Arrldq(i, nd(ii) - 2000 + 21)
    
21.         rdc = rdc + Arrldq(i, nd(ii) - 2000 + 51)
    
22.         rdu = rdu + Arrldq(i, nd(ii) - 2000 + 61)
    
23.         oe = oe + Arrldq(i, nd(ii) - 2000 + 41)
    
24.         gxrxh = gxrxh + Arrldq(i, nd(ii) - 2000 + 71)  '关系人销货
    
25.         gxrjh = gxrjh + Arrldq(i, nd(ii) - 2000 + 81)  '关系人进货
    
26.         cogs = cogs + Arrldq(i, nd(ii) - 2000 + 31)  'COGS
    
27.         If Arrldq(i, nd(ii) - 2000 + 21) > 0 Then m = m + 1
    
28.         If Arrldq(i, nd(ii) - 2000 + 31) > 0 Then m = m + 1
    
29.         If Arrldq(i, nd(ii) - 2000 + 41) > 0 Then m = m + 1
    
30.         If Arrldq(i, nd(ii) - 2000 + 91) < 0 Then mm = mm + 1
    
31.     Next
    
32.     For j = 1 To UBound(Brrdr, 2)
    
33.         If j = 1 Then
    
34.             Brrdr(i, j) = Arrldq(i, j + 101) 'DR18=CX18
    
35.         ElseIf j < 11 Then
    
36.             If Arrldq(i, j + 111) <> 0 Then 'DS18
    
37.                 Brrdr(i, j) = (Arrldq(i, j + 101) + Arrldq(i, j + 102)) / 2
    
38.             Else
    
39.                 Brrdr(i, j) = Arrldq(i, j + 102)
    
40.             End If
    
41.         ElseIf j = 11 Then   'EB  WA RD to Sales
    
42.             If sale <> 0 Then
    
43.             If rdc > 0 Then
    
44.                 Brrdr(i, j) = rdc / sale
    
45.             Else
    
46.                 Brrdr(i, j) = rdu / sale
    
47.             End If
    
48.             End If
    
49.         ElseIf j = 12 Then
    
50.             If sale <> 0 Then
    
51.                 Brrdr(i, j) = oe / sale  'EC  WA OE to Sales
    
52.             End If
    
53.         ElseIf j = 13 Then
    
54.             For ii = 1 To n1
    
55.                 fa = fa + Brrdr(i, nd(ii) - 2000)
    
56.             Next
    
57.             If sale <> 0 Then
    
58.                 Brrdr(i, j) = fa / sale  'ED  WA FA to Sales
    
59.             End If
    
60.         ElseIf j = 14 Then
    
61.             If sale <> 0 Then
    
62.                 Brrdr(i, j) = gxrxh / sale  'EE  WA 关系人销货 to Sales
    
63.             End If
    
64.         ElseIf j = 15 Then
    
65.             If cogs <> 0 Then
    
66.                 Brrdr(i, j) = gxrjh / cogs  'EE  WA 关系人进货 to COGS
    
67.             End If
    
68.         ElseIf j = 17 Then
    
69.             If m = 3 * n1 Then
    
70.                 Brrdr(i, j) = "接受"  'EH  缺少连续五年
    
71.             Else
    
72.                 Brrdr(i, j) = "拒绝"
    
73.             End If
    
74.         ElseIf j = 18 Then  'EI  任意X年
    
75.             If Brrdr(i, j - 1) = "拒绝" Then
    
76.                 Brrdr(i, j) = "拒绝"
    
77.             Else
    
78.                 If mm >= [EI16].Value Then
    
79.                     Brrdr(i, j) = "拒绝"
    
80.                 Else
    
81.                     Brrdr(i, j) = "接受"
    
82.                 End If
    
83.             End If
    
84.         ElseIf j = 19 Then  'EJ  RD to Sales
    
85.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Then
    
86.                 Brrdr(i, j) = "拒绝"
    
87.             Else
    
88.                 If [c11] <> "" Then
    
89.                     If Brrdr(i, 11) < [c11].Value Then Brrdr(i, j) = "拒绝": GoTo 100
    
90.                 End If
    
91.                 If [d11] <> "" Then
    
92.                     If Brrdr(i, 11) > [d11].Value Then Brrdr(i, j) = "拒绝": GoTo 100
    
93.                 End If
    
94.                 Brrdr(i, j) = "接受"
    
95.             End If
    
96.         ElseIf j = 20 Then  'EK  OE to Sales
    
97.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Then
    
98.                 Brrdr(i, j) = "拒绝"
    
99.             Else
    
100.                 If [c12] <> "" Then
     
101.                     If Brrdr(i, 12) < [c12].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
102.                 End If
     
103.                 If [d12] <> "" Then
     
104.                     If Brrdr(i, 12) > [d12].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
105.                 End If
     
106.                 Brrdr(i, j) = "接受"
     
107.             End If
     
108.         ElseIf j = 21 Then  'EJ  FA to Sales
     
109.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Then
     
110.                 Brrdr(i, j) = "拒绝"
     
111.             Else
     
112.                 If [c13] <> "" Then
     
113.                     If Brrdr(i, 13) < [c13].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
114.                 End If
     
115.                 If [d13] <> "" Then
     
116.                     If Brrdr(i, 13) > [d13].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
117.                 End If
     
118.                 Brrdr(i, j) = "接受"
     
119.             End If
     
120.         ElseIf j = 22 Then  'EM  关系人销货 to Sales
     
121.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Or Brrdr(i, j - 5) = "拒绝" Then
     
122.                 Brrdr(i, j) = "拒绝"
     
123.             Else
     
124.                 If [c14] <> "" Then
     
125.                     If Brrdr(i, 14) < [c14].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
126.                 End If
     
127.                 If [d14] <> "" Then
     
128.                     If Brrdr(i, 14) > [d14].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
129.                 End If
     
130.                 Brrdr(i, j) = "接受"
     
131.             End If
     
132.         ElseIf j = 23 Then  'EN  关系人销货 to Sales
     
133.             If Brrdr(i, j - 1) = "拒绝" Or Brrdr(i, j - 2) = "拒绝" Or Brrdr(i, j - 3) = "拒绝" Or Brrdr(i, j - 4) = "拒绝" Or Brrdr(i, j - 5) = "拒绝" Or Brrdr(i, j - 6) = "拒绝" Then
     
134.                 Brrdr(i, j) = "拒绝"
     
135.             Else
     
136.                 If [c15] <> "" Then
     
137.                     If Brrdr(i, 15) < [c15].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
138.                 End If
     
139.                 If [d15] <> "" Then
     
140.                     If Brrdr(i, 15) > [d15].Value Then Brrdr(i, j) = "拒绝": GoTo 100
     
141.                 End If
     
142.                 Brrdr(i, j) = "接受"
     
143.             End If
     
144.         
     
145.         End If
     
146. 100:
     
147.     Next
     
148. Next
     
149. Range("dr18").Resize(UBound(Brrdr), UBound(Brrdr, 2)) = Brrdr
     
150. [eh13:en15].ClearContents
     
151. Dim jsjj
     
152. jsjj = [eh13:en15]
     
153. For i = 17 To 23
     
154.     For j = 1 To UBound(Brrdr)
     
155.         If Brrdr(j, i) = "接受" Then
     
156.             jsjj(1, i - 16) = jsjj(1, i - 16) + 1
     
157.         Else
     
158.             jsjj(2, i - 16) = jsjj(2, i - 16) + 1
     
159.         End If
     
160.         jsjj(3, i - 16) = jsjj(3, i - 16) + 1
     
161.     Next
     
162. Next
     
163. [eh13].Resize(3, 7) = jsjj
     
164. 
     
165. End Sub

复制代码

piny

謝謝回復 由於老師不是用5樓修改 我需暫修改成代碼中部分wording 再行測試

先感謝協助

蓝桥玄霜

请见附件。

piny

不好意思 AFA好像有錯位 EB列到EF列之值亦與驗算值出入 可是我不會修改

再說明一下需求，可對應附件之「參考」活頁說明

2001 AFA一定等於2001 FA

2002 AFA之計算方法有兩種情況（不需再考慮其他情況）       
情況一：2001 TA大於0，則2002 AFA = ( 2001 FA + 2002 FA ) / 2
情況二：2001 TA為0，則2002 AFA = 2002 FA

2003 AFA至2010 AFA之需求同2002 AFA

WA RD

1. =(IF(BC18,BC18,BM18)+IF(BD18,BD18,BN18)+IF(BE18,BE18,BO18)+IF(BF18,BF18,BP18)+IF(BG18,BG18,BQ18))/(Y18+Z18+AA18+AB18+AC18)

复制代码

即分析年度中，若該年度RD C大於0，就加總該RD C，否則即加總RD U，再除以Sales之加總

WA OE

1. =(AS18+AT18+AU18+AV18+AW18)/(Y18+Z18+AA18+AB18+AC18)

复制代码

即分析年度之OE加總，除以Sales之加總
餘WA之算法同WA OE（即分析年度之所求分子加總除以分析年度之Sales或COGS加總）

EH至EN暫未驗算，先解決前面半部！ ^^

蓝桥玄霜

这个问题“2001 AFA一定等於2001 FA

2002 AFA之計算方法有兩種情況（不需再考慮其他情況）”，可能是你附件中的数据错了？请看一下附件中我的说明。
后一个问题已经修改。