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

[µo°Ý] ¬Y­Ó½d³ò¤º¨Ì¾Ú±ø¥ó¶ñ¤WÃC¦â

[µo°Ý] ¬Y­Ó½d³ò¤º¨Ì¾Ú±ø¥ó¶ñ¤WÃC¦â




TurnR.rar (10.83 KB)

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-8 13:06 ½s¿è

¦^´_ 1# maiko


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
½Ð«e½ú¸Õ¬Ý¬Ý
¤µ¤Ñ²ß±o
WorksheetFunction.Max()
CDate()
Format(date, "dddd")
Union()
½m²ß°}¦C»P¦r¨å

­ì©l:


µ²ªG:


Option Explicit
Sub ·j´MÅܦâ()
Dim xA, Arr, Ra As Range, i&, x&, T, Ts, T1, T2, Tn
Dim xD, Rng As Range, Ct
'¡ô«Å§iÅܼÆ

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å

Set xA = [A1].CurrentRegion.Offset(1, 0)
'¡ô±NxAÀx¦s®æ³]¬° ([A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,
'ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò,
'©¹¤U°¾²¾¤@¦C )


Arr = [I1].CurrentRegion.Offset(1, 0)
'¡ô±N ([I1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,
'ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò,
'©¹¤U°¾²¾¤@¦C ),
'­Ë¤JArr°}¦C¤¤


Arr(UBound(Arr), 1) = CDate(WorksheetFunction.Max(xA))
'¡ô¥OArr°}¦Cªº³Ì¥ª¤U¨¤¨º®æ¬OxAÀx¦s®æ¸Ìªº³Ì¤j­È
'¨ÃÂà´«¬°¤é´Á YYYY/M/D ¦b°}¦C¤¤§e²{


For i = 1 To UBound(Arr) - 1
'¡ô³]©w°j°é±NArr³o¨Ç³Q·j´Mªº¤é´Á½d³ò»PJ.KÄæÃöÁä¦r²Õ¦¨¦r¦ê·íKEY
'­Ë¤JxD°}¦C¤¤,ITEM³]¬°6(ITEM³]>0ªº¼Æ¦r´N¥i¥H!¦]¬°ITEM¨S¦³¥Î¨ì)


   Ts = Arr(i, 1)
   Tn = Arr(i + 1, 1)
   T1 = Arr(i, 2)
   T2 = Arr(i, 3)
   T = Tn - Ts
   For x = 0 To T
      xD(Ts + x & T1) = 6
      xD(Ts + x & T2) = 6
   Next
Next
For Each Ra In xA
'¡ô³]©w°j°é±NxA¸ÌªºÀx¦s®æ²Õ¦¨¦r¦ê,
'(YYYY/M/D&Weekday)¤§«á
'¨ìxD¦r¨å¸Ì¬d¬Ý¬Ý¬O§_¬d±o¨ì,
'¦pªG¦³´N§âÀx¦s®æ©ñ¤JRngÀx¦s®æ¶°¸Ì


   Ct = Ra & Format(Ra, "dddd")
   If xD(Ct) Then
      If Rng Is Nothing Then
         Set Rng = Ra
         Else
            Set Rng = Union(Rng, Ra)
      End If
   End If
Next
Rng.Interior.ColorIndex = 38
'¡ô³Ì«á§âÀx¦s®æ¶°ªº©³¦âÅܧ󬰷Q­nªºÃC¦â

End Sub

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

hcm19522 µoªí©ó 2022-10-8 15:41



    ·PÁÂÀ°§U¡I

TOP

¦^´_  maiko


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
½Ð«e½ú¸Õ¬Ý¬Ý
¤µ¤Ñ²ß±o
WorksheetFunction.Max()
CDa ...
Andy2483 µoªí©ó 2022-10-8 13:04



    §A¦n¡A¦b2022-02-07³o­Ó¬P´ÁÀ³¸Ó¬O Tuesday        Wednesday ³o¨â¤Ñªº¡A¦ý¬O2022-02-07 Monday¤]¶ñ¤WÃC¦â¡A¦³³o»òªº¤p¤p¿ù»~¡C
¤£¹LÁÙ¬O·PÁ§AªºÀ°§U¡I

TOP

¦^´_ 5# maiko
ÁÂÁ«e½ú«ü¾É
«á¾Ç¥u¤@ªÑ¸£½m²ß§Þ¥©
«á¾Ç¨S°µ¦nÅçÃÒªºµ{§Ç
ÁÂÁ«e½úÀ°¦£°µ¤FÅçÃÒ
ÁÂÁÂ

TOP

¦^´_ 4# maiko


    ¥t¸Ñ=(VLOOKUP($A2,$I:$K,2,1)=A$1)+(VLOOKUP($A2,$I:$K,3,1)=A$1)
google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

§A¦n¡A¦b2022-02-07³o­Ó¬P´ÁÀ³¸Ó¬O Tuesday        Wednesday ³o¨â¤Ñªº¡A¦ý¬O2022-02-07 Monday¤]¶ñ¤WÃC ...
maiko µoªí©ó 2022-10-9 06:05



    ÁÂÁ«e½ú«ü¥¿
«á¾ÇÀË°Q­×¥¿»PÀË´ú¦p¤U:
­ì©l ¤u§@ªí1 ¦³¤W¦âªºÀx¦s®æµe­±:


¥t½Æ»s¤@¥÷¤u§@ªí ©R¦W¬° ¤u§@ªíN ¥þµL©³¦â:


°õ¦æµ{¦¡½X«á §Y¨Ã±Æ°µ¤ñ¸û:


ºu°Ê·Æ¹«°µ¤ñ¸û2:


ºu°Ê·Æ¹«°µ¤ñ¸û3:


ºu°Ê·Æ¹«°µ¤ñ¸û4:


ÁÂÁ«e½ú«ü¾É!
¦A¦³¿ù¤]½Ð¦A«ü¾É!

TOP

¦^´_ 5# maiko


    ¤µ¤Ñ²ß±o¦PÀÉ®×,¤£¦P¤u§@ªí!¶}¤ßµøµ¡¨Ã±Æ¥Øµø¤ñ¸û
¤ß±o¦p¤U:

Option Explicit
Sub ·j´MÅܦâ()
Dim xA, Arr, Ra As Range, i&, x&, T, Ts, T1, T2, Tn
Dim xD, Rng As Range, Ct, Awn
'¡ô«Å§iÅܼÆ

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å

Set xA = Sheets("¤u§@ªíN").[A1].CurrentRegion.Offset(1, 0)
'¡ô±NxAÀx¦s®æ³]¬° ([A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,
'ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò,
'©¹¤U°¾²¾¤@¦C )


Arr = [I1].CurrentRegion.Offset(1, 0)
'¡ô±N ([I1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,
'ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò,
'©¹¤U°¾²¾¤@¦C ),
'­Ë¤JArr°}¦C¤¤


Arr(UBound(Arr), 1) = CDate(WorksheetFunction.Max(xA) + 1)
'¡ô¥OArr°}¦Cªº³Ì¥ª¤U¨¤¨º®æ¬OxAÀx¦s®æ¸Ìªº³Ì¤j­È
'¨ÃÂà´«¬°¤é´Á YYYY/M/D ¦b°}¦C¤¤§e²{


'¡ô³o¸Ì¬O¥Ç¿ùªº¦a¤è!»Ý­n¦A¥[1,¤~¯à²[»\xA½d³ò¸Ìªº³Ì¤j¤é´Á

For i = 1 To UBound(Arr) - 1
'¡ô³]©w°j°é±NArr³o¨Ç³Q·j´Mªº¤é´Á½d³ò»PJ.KÄæÃöÁä¦r²Õ¦¨¦r¦ê·íKEY
'­Ë¤JxD°}¦C¤¤,ITEM³]¬°6(ITEM³]>0ªº¼Æ¦r´N¥i¥H!¦]¬°ITEM¨S¦³¥Î¨ì)


   Ts = Arr(i, 1)
   Tn = Arr(i + 1, 1)
   T1 = Arr(i, 2)
   T2 = Arr(i, 3)
   T = Tn - Ts - 1
   '¡ô³o¸Ì¤]¬O¥Ç¿ùªº¦a¤è!¤Ö´î¤F1
   
   For x = 0 To T
      xD(Ts + x & T1) = 0.1
      xD(Ts + x & T2) = 0.1
   Next
Next
For Each Ra In xA
'¡ô³]©w°j°é±NxA¸ÌªºÀx¦s®æ²Õ¦¨¦r¦ê,
'(YYYY/M/D&Weekday)¤§«á
'¨ìxD¦r¨å¸Ì¬d¬Ý¬Ý¬O§_¬d±o¨ì,
'¦pªG¦³´N§âÀx¦s®æ©ñ¤JRngÀx¦s®æ¶°¸Ì


   Ct = Ra & Format(Ra, "dddd")
   If xD(Ct) Then
      If Rng Is Nothing Then
         Set Rng = Ra
         Else
            Set Rng = Union(Rng, Ra)
      End If
   End If
Next
xA.Interior.ColorIndex = xlNone
'¡ô§âA:GÄ檺¦â¥þ³¡Åܬ°µL©³¦â

Rng.Interior.ColorIndex = 38
'¡ô³Ì«á§âÀx¦s®æ¶°ªº©³¦âÅܧ󬰷Q­nªºÃC¦â

Awn = ActiveWorkbook.Name
'¡ô¥OAwn¬O¥»ÀɪºÀɦW

ActiveWindow.NewWindow
'¡ô±N¥»ÀɦA¶}¥t¤@­Óµøµ¡

Sheets("¤u§@ªí1").Activate
'¡ô³oµøµ¡Åã¥Ü¦b "¤u§@ªí1" ¤u§@ªí¤W

Windows.CompareSideBySideWith Awn & ":1"
'¡ôÅý¨â­Óµøµ¡¨Ã±Æ¤ñ¸û

Windows.SyncScrollingSideBySide = True
'¡ôÅý¨â­Óµøµ¡¦P®Éºu°Ê°µ¤ñ¸û
   
End Sub

TOP

¦^´_  maiko


    ¤µ¤Ñ²ß±o¦PÀÉ®×,¤£¦P¤u§@ªí!¶}¤ßµøµ¡¨Ã±Æ¥Øµø¤ñ¸û
¤ß±o¦p¤U:

Option Explicit
...
Andy2483 µoªí©ó 2022-10-11 09:11



    ·PÁÂÀ°§U¡A¾Ç¨ì«Ü¦hªF¦è¡I

TOP

        ÀR«ä¦Û¦b : ­n¤ñ½Ö§ó¨ü½Ö¡D¤£­n¤ñ½Ö§ó©È½Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD