- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-9-30
|
¦^´_ 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®æ¶°ªº©³¦âÅܧ󬰷QnªºÃ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 |
|