- 帖子
- 1527
- 主題
- 40
- 精華
- 0
- 積分
- 1551
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-11-4
|
9#
發表於 2022-10-11 09:11
| 只看該作者
回復 5# maiko
今天習得同檔案,不同工作表!開心視窗並排目視比較
心得如下:
Option Explicit
Sub 搜尋變色()
Dim xA, Arr, Ra As Range, i&, x&, T, Ts, T1, T2, Tn
Dim xD, Rng As Range, Ct, Awn
'↑宣告變數
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是字典
Set xA = Sheets("工作表N").[A1].CurrentRegion.Offset(1, 0)
'↑將xA儲存格設為 ([A1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 )
Arr = [I1].CurrentRegion.Offset(1, 0)
'↑將 ([I1]相鄰非空格所串連起來的儲存格,
'擴展到方正區域的最小範圍,
'往下偏移一列 ),
'倒入Arr陣列中
Arr(UBound(Arr), 1) = CDate(WorksheetFunction.Max(xA) + 1)
'↑令Arr陣列的最左下角那格是xA儲存格裡的最大值
'並轉換為日期 YYYY/M/D 在陣列中呈現
'↑這裡是犯錯的地方!需要再加1,才能涵蓋xA範圍裡的最大日期
For i = 1 To UBound(Arr) - 1
'↑設定迴圈將Arr這些被搜尋的日期範圍與J.K欄關鍵字組成字串當KEY
'倒入xD陣列中,ITEM設為6(ITEM設>0的數字就可以!因為ITEM沒有用到)
Ts = Arr(i, 1)
Tn = Arr(i + 1, 1)
T1 = Arr(i, 2)
T2 = Arr(i, 3)
T = Tn - Ts - 1
'↑這裡也是犯錯的地方!少減了1
For x = 0 To T
xD(Ts + x & T1) = 0.1
xD(Ts + x & T2) = 0.1
Next
Next
For Each Ra In xA
'↑設定迴圈將xA裡的儲存格組成字串,
'(YYYY/M/D&Weekday)之後
'到xD字典裡查看看是否查得到,
'如果有就把儲存格放入Rng儲存格集裡
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欄的色全部變為無底色
Rng.Interior.ColorIndex = 38
'↑最後把儲存格集的底色變更為想要的顏色
Awn = ActiveWorkbook.Name
'↑令Awn是本檔的檔名
ActiveWindow.NewWindow
'↑將本檔再開另一個視窗
Sheets("工作表1").Activate
'↑這視窗顯示在 "工作表1" 工作表上
Windows.CompareSideBySideWith Awn & ":1"
'↑讓兩個視窗並排比較
Windows.SyncScrollingSideBySide = True
'↑讓兩個視窗同時滾動做比較
End Sub |
|
