- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-15 16:31 ½s¿è
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å¥t¤@¤è®×,¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
Option Explicit
Sub TEST_1()
Dim Brr, Crr, Z, i&, j%, R&, C, Ta, jj#, Ce%, xA As Range, A
Set Z = CreateObject("Scripting.Dictionary")
Set xA = Range([A1], ActiveSheet.UsedRange)
Brr = Union(xA, xA.Offset(, 1))
Ta = [{"¶µ¥Ø","¤µ¦~°_ÂI","¥Ø«e¶i«×","¹F¦¨²v"}]
Ce = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To UBound(Ta)
C = Application.Match(Ta(i), [1:1], 0)
If IsError(C) Then MsgBox "¨S¦³ " & Ta(i) & " ¼ÐÃD": Exit Sub Else Ta(i) = C
Next
For j = Ta(4) To Ce + 1
If Val(Brr(1, j + 1)) = 0 Then Exit For
Z("(" & Val(Brr(1, j)) & "-|)*(" & Val(Brr(1, j + 1)) & "-|)") = j
Next
ReDim Crr(1 To UBound(Brr), 1 To 100)
For i = 2 To Cells(Rows.Count, Ta(1)).End(3).Row
If Brr(i, Ta(1)) = "" Then Exit For Else R = R + 1
For j = 1 To Ce - Ta(4)
Crr(R, j) = Round((1 + (Brr(1, Ta(4) + j) / 100)) * Brr(i, Ta(2)), 2)
Next
Rows(i).Interior.ColorIndex = xlNone
jj = Round((Brr(i, Ta(3)) - Brr(i, Ta(2))) / Brr(i, Ta(2)) * 100, 2)
Brr(R, 1) = jj: If jj < 0 Then Cells(i, Ta(4)).Interior.ColorIndex = 3: GoTo i01
For Each A In Z.KEYS
C = Replace(A, "|", jj)
If Evaluate(C) <= 0 Then Cells(i, Z(A) - (Evaluate(C) = 0)).Interior.ColorIndex = 6: Exit For
A01: Next
If jj < 10 Then Cells(i, Ta(4)).Interior.ColorIndex = 42
i01: Next
Cells(2, Ta(4) + 1).Resize(R, Ce - Ta(4)) = Crr
Cells(2, Ta(4)).Resize(R, 1) = Brr
End Sub
'============================================
¥H¤U¬O¨S¦³¥Î¦r¨åªº°}¦C¤è®×: (°µ¤Fµù¸Ñ¤è«K¥Î¤â¾÷ ¬d¬Ý°µ½Æ²ß)
Option Explicit
Sub TEST_2()
Dim Brr, Crr, i&, j%, R&, C, Ta, jj#, Ce%, xA As Range, A#
'¡ô«Å§iÅܼÆ
Set xA = Range([A1], ActiveSheet.UsedRange)
'¡ô¥OxAÅܼƬO¦³¨Ï¥ÎÀx¦s®æ¤è¥¿°Ï°ì
Brr = Union(xA, xA.Offset(, 1))
'¡ô¥OBrrÅܼƬO±a¤J(xA½d³òÀx¦s®æ©¹¥kÂX¼W1Äæ)Àx¦s®æȪº¤Gºû°}¦C
Ta = [{"¶µ¥Ø","¤µ¦~°_ÂI","¥Ø«e¶i«×","¹F¦¨²v"}]
'¡ô¥OTaÅܼƬO¯Á¤Þ¸¹1~4ªº¥|²Õ¦r¦ê¤@ºû°}¦C
Ce = xA(1, Columns.Count).End(xlToLeft).Column
'¡ô¥OCeÅܼƬO²Ä1¦C³Ì¥kÃ䦳¤º®eÀx¦s®æÄæ¦ì¼Æ
For i = 1 To UBound(Ta)
'¡ô³]¶¶°j°é!i±q1 ¨ìTa°}¦C³Ì¤j¯Á¤Þ¸¹
C = Application.Match(Ta(i), [1:1], 0)
'¡ô¥OCÅܼƬO¥H°õ¦æÀx¦s®æ¨ç¼Æ Match() ¦^¶ÇÈ
If IsError(C) Then MsgBox "¨S¦³ " & Ta(i) & " ¼ÐÃD": Exit Sub Else Ta(i) = C
'¡ô¦pªG§ä¤£¨ì¼ÐÃD´N¸õ¥X´£µøµ¡~~,µ²§ôµ{¦¡°õ¦æ,§_«h¥OTa°}¦CÈÅܦ¨CÅܼÆ(Äæ¦ì¼Æ)
Next
ReDim Crr(1 To UBound(Brr), 1 To 100)
'¡ô«Å§iCrrÅܼƬO¤GºûªÅ°}¦C,½d³ò¤j¤p¶·¤ñ»Ý¨D¤j©Îè¦n
For i = 2 To xA(Rows.Count, Ta(1)).End(3).Row
'¡ô³]¶¶°j°é!i±q2 ¨ì ¶µ¥ØÄæ¤U´M³Ì«áÓ¦³¤º®eªºÀx¦s®æ¦C¸¹
If Brr(i, Ta(1)) = "" Then Exit For Else R = R + 1
'¡ô¦pªG¶µ¥ØÄæ°j°é¦C°}¦CȬOªÅªº´Nµ²§ô°j°é,§_«h¥ORÅܼƲ֥[1
For j = 1 To Ce - Ta(4)
'¡ô³]¶¶°j°é!±N¼ÐÃD¦U¬q¸¨¹F¦¨²v%+1¼¤W ¤µ¦~°_ÂI,¼¿n¨ú¤p¼Æ2¦ì,¼g¤JCrr°}¦C¤¤
Crr(R, j) = Round((1 + (Brr(1, Ta(4) + j) / 100)) * Brr(i, Ta(2)), 2)
Next
Rows(i).Interior.ColorIndex = xlNone
'¡ô¥O°j°é¦C©³¦â¬°µL©³¦â
jj = Round((Brr(i, Ta(3)) - Brr(i, Ta(2))) / Brr(i, Ta(2)) * 100, 2)
'¡ô¥OjjÅܼƬO¹ê»Ú¹F¦¨²v
Brr(R, 1) = jj: If jj < 0 Then xA(i, Ta(4)).Interior.ColorIndex = 3: GoTo i01
'¡ô¥O¹ê»Ú¹F¦¨²v¼g¤JBrr°}¦C³Ì¥ª¤W¨¤,©¹¤UÄ~Äò¼g¤J
'¦pªG¹ê»Ú¹F¦¨²v<0,´N¥O°j°é¦C¹F¦¨²vÄæÀx¦s®æ©³¦â¬O ¬õ¦â,¤§«á¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ
For j = Ta(4) To UBound(Brr, 2)
'¡ô³]¶¶°j°é§P©wþ¤@ÄæÀx¦s®æ©³¦â¶·Åܬ°¶À¦â
If Val(Brr(1, j + 1)) = 0 Then Exit For
'¡ô¦pªG¶]¨ì³Ì«áÄæ´Nµ²§ô°j°é
A = (Val(Brr(1, j)) - jj) * (Val(Brr(1, j + 1)) - jj)
'¡ô¥OAÅܼƬO¥H(jÄæ¬q¸¨¹F¦¨²v-¹ê»Ú¹F¦¨²v)*(j+1Äæ¬q¸¨¹F¦¨²v-¹ê»Ú¹F¦¨²v)¼¿n
If A <= 0 Then
'¡ô¦pªGAÅܼƬOt¼Æ©Î 0
xA(i, j - (A = 0)).Interior.ColorIndex = 6
'¡ô¦pªGA¬O0,¥kÃä®æ¶À©³,§_«h´N·í®æ¶À©³
Exit For
'¡ô¥O¸õ¥X°j°é
End If
Next
If jj < 10 Then xA(i, Ta(4)).Interior.ColorIndex = 41
'¡ô¦pªG¦pªG¹ê»Ú¹F¦¨²v¤p©ó10%,´N¥Oi°j°é¦C¹F¦¨²vÄæÀx¦s®æ ÂÅ©³
i01: Next
xA(2, Ta(4) + 1).Resize(R, Ce - Ta(4)) = Crr
'¡ô¥O¬q¸¨¹F¦¨²v¼g¤JÀx¦s®æ
xA(2, Ta(4)).Resize(R, 1) = Brr
'¡ô¥O¹ê»Ú¹F¦¨²v¼g¤JÀx¦s®æ
End Sub |
|