- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2025-3-24
|
¦^´_ 10# ã´£³¡ªL
ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×,¤è®×¾Ç²ß¤ß±oµù¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É
¸ê®Æªí:
µ²ªGªí:
Sub TEST_A01()
Dim Arr, xD, i&, j%, N&, T$, U&
'¡ô«Å§iÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxDÅܼƬO ¦r¨å
Sheets("¤u§@ªí2").UsedRange.EntireRow.Delete
'¡ô¥Oªí2¨Ï¥ÎÀx¦s®æ©Ò¦bªº¦C§R°£
Arr = Range([¤u§@ªí1!I1], [¤u§@ªí1!A1].Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥Hªí1ªºA~IÄæÀx¦s®æÈ±a¤J°}¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
T = Arr(i, 2) & "|"
'¡ô¥OTÅܼƬO²Ä2Äæ°}¦Cȳs±µ"|"²Å¸¹ªº·s¦r¦ê
If Arr(i, 4) = "²Õ¦X§é¦©" Then T = T & "S"
'¡ô¦pªG²Ä4Äæ°}¦CȬO "²Õ¦X§é¦©"¦r¦ê!´N¥OTÅܼƦA³s±µ"S"¦r¤¸
For j = 6 To 9: xD(T & j) = xD(T & j) + Arr(i, j): Next
'¡ô³]¶¶°j°é!¥OTÅܼƳs±µj°j°é¼Æªº·s¦r¦ê·íkey,
'¨äitemȦU²Ö¥[jÅܼƷíÄæªºArr°}¦CÈ
Next i
'-----------------------------------
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
If Arr(i, 4) = "²Õ¦X§é¦©" Then GoTo i01
'¡ô¦pªG²Ä4Äæ°}¦CȬO "²Õ¦X§é¦©"¦r¦ê!´N¤£³B²z«áÄò,¸õ¨ìi01¦ì¸mÄ~Äò°õ¦æ
T = Arr(i, 2) & "|"
'¡ô¥OTÅܼƬO²Ä2Äæ°}¦Cȳs±µ"|"²Å¸¹ªº·s¦r¦ê,¥["|"¬O¨¾¸U¤@
N = N + 1
'¡ô¥ONÅܼƲ֥[1(²Ö¥[µ²ªG¦C¼Æ,¤@¶}©l´N+1¬O¬°¤FªÅ¥X¼ÐÃDªº¦C)
For j = 1 To 5: Arr(N + 1, j) = Arr(i, j): Next
'¡ô³]¶¶°j°é!¥OArr°}¦C±q²Ä¤G¦C¶}©l¼g¤Jµ²ªGÈ(1~5Äæ)
For j = 6 To 9
'¡ô³]¶¶°j°é
Arr(N + 1, j) = Arr(i, j) + Arr(i, j) * (xD(T & "S" & j) / xD(T & j))
'¡ô¥O6~9ÄæArr°}¦Cȵ²ªG¦C¬O
'°j°é¦CÓÄæÈ+ °j°é¦CÓÄæÈ*(²Õ¦X§é¦©Á`ª÷ÃB/«D²Õ¦X§é¦©Á`ª÷ÃB)
'pºâ²Õ¦X§é¦©«á¥§¡»ù®æ(¦]¬°²Õ¦X§é¦©È¬OtÈ,©Ò¥H¬O¥Î¬Û¥[pºâ)
Next j
i01: Next i
'-----------------------------------
[¤u§@ªí2!A1:I1].Resize(N + 1) = Arr
'¡ô¥Oªí2¼g¤JArr°}¦CÈ,¶W¹Lµ²ªGȪº°}¦CÈ©¿²¤
End Sub |
|