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

[µo°Ý] ¦p¦ó¥ÎÃC¦âÅã¥Ü¹F¦¨²v

[µo°Ý] ¦p¦ó¥ÎÃC¦âÅã¥Ü¹F¦¨²v

¦p¦ó¦b[¦Ê¤À¤ñ]¦ì¸mÅã¥ÜÃC¦â,ÁÂÁÂ.

1121214.rar (8.7 KB)

§ù¤p¥­

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-15 13:03 ½s¿è

¦^´_ 1# dou10801


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, j%, R&, C, Ta, jj#, Ce%, xA As Range
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 Z(Ta(i) & "") = C
Next
For j = Z.Items()(3) To Ce + 1
   If Val(Brr(1, j + 1)) = 0 Then Exit For
   For jj = Val(Brr(1, j)) To Val(Brr(1, j + 1)) Step 0.01: Z(Format(jj, "000.00")) = j: Next
Next
ReDim Crr(1 To UBound(Brr), 1 To 100)
For i = 2 To Cells(Rows.Count, Z("¶µ¥Ø")).End(3).Row
   If Brr(i, Z("¶µ¥Ø")) = "" Then Exit For Else R = R + 1
   For j = 1 To Ce - Z("¹F¦¨²v")
      Crr(R, j) = Round((1 + (Brr(1, Z("¹F¦¨²v") + j) / 100)) * Brr(i, Z("¤µ¦~°_ÂI")), 2)
   Next
   Rows(i).Interior.ColorIndex = xlNone
   jj = Round((Brr(i, Z("¥Ø«e¶i«×")) - Brr(i, Z("¤µ¦~°_ÂI"))) / Brr(i, Z("¤µ¦~°_ÂI")) * 100, 2)
   Brr(R, 1) = jj:   If jj < 0 Then Cells(i, Z("¹F¦¨²v")).Interior.ColorIndex = 3: GoTo i01
   C = Z(Format(jj, "000.00")):    Cells(i, C).Interior.ColorIndex = 6
   If jj < 10 Then Cells(i, Z("¹F¦¨²v")).Interior.ColorIndex = 43
i01: Next
Cells(2, Z("¹F¦¨²v") + 1).Resize(R, Ce - Z("¹F¦¨²v")) = Crr
Cells(2, Z("¹F¦¨²v")).Resize(R, 1) = Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¥»©«³Ì«á¥Ñ hcm19522 ©ó 2023-12-15 13:58 ½s¿è

(¿é¤J½s¸¹12140) googleºô§}:https://hcm19522.blogspot.com/
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¥»©«³Ì«á¥Ñ 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ÅܼƬO­t¼Æ©Î 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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 4# Andy2483
·PÁ«e½ú«ü¾É,[¥H¤U¬O¨S¦³¥Î¦r¨åªº°}¦C¤è®×:]µ{¦¡½X°õ¦æ«á,(¶µ¥Ø)=>"H" ,¨S¦³Åã¥Ü[¶À¼Ð] ,ÁÂÁÂ.
§ù¤p¥­

TOP

¦^´_ 5# dou10801


    ÁÂÁ«e½ú¦^´_
«á¾Ç½k¶î,§Ñ¤F°j°é¬O¶]°}¦CªºÄæ¦ì,½Ð­×§ï
For j = Ta(4) To UBound(Brr)   >>    For j = Ta(4) To UBound(Brr,2)
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¨S¦³©Ò¦³Åv¡A¥u¦³¥Í©Rªº¨Ï¥ÎÅv¡C
ªð¦^¦Cªí ¤W¤@¥DÃD