儲存格資料有變動顏色提醒

請問各位大大
資料是從WEB匯入
開啟活頁簿後會自動更新
希望有變動數據的儲存格會顏色提醒(比方變成黃底)
謝謝各位大大

樓主熱帖

coafort

中學生 Rank: 2

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

7^#

發表於 2023-4-12 19:20 | 只看該作者

回復 coafort

ThisWorkbook？
這帖的4樓有圖片可看
Andy2483 發表於 2023-4-12 19:02

了解

非常謝謝大大

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

6^#

發表於 2023-4-12 19:02 | 只看該作者

本帖最後由 Andy2483 於 2023-4-12 19:07 編輯

回復 5# coafort

http://forum.twbts.com/thread-23945-1-1.html

ThisWorkbook？
這帖的4樓有圖片可看

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort

中學生 Rank: 2

帖子: 162
主題: 33
精華: 0
積分: 243
點名: 0
作業系統: win7
軟體版本: excel 2003
閱讀權限: 20
註冊時間: 2018-1-5
最後登錄: 2024-10-22

5^#

發表於 2023-4-12 16:38 | 只看該作者

回復 coafort

謝謝前輩回復
後學學習方案如下,請前輩參考
1.在 ThisWorkbook 模組裡植入以下程 ...
Andy2483 發表於 2023-4-12 12:54

謝謝大大
請問大大是在ThisWorkbook按右鍵插入模組嗎？
謝謝

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

4^#

發表於 2023-4-12 12:54 | 只看該作者

回復 3# coafort

謝謝前輩回復
後學學習方案如下,請前輩參考
1.在 ThisWorkbook 模組裡植入以下程式碼
2.停留在檔案開啟更新WEB資料的工作表
3.儲存檔案
4.關閉檔案
5.重新開啟此檔案

Option Explicit
Public Brr0412, Sh0412 As Worksheet, xR0412 As Range
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Sh0412.Activate
On Error GoTo 0
End Sub
'===============================
Private Sub Workbook_Open()
Call 置入輔助表_隱藏
Call 更新WEB資料
Call 比對_不同值變底色
End Sub
'===============================
Sub 置入輔助表_隱藏()
Application.DisplayAlerts = False
Set Sh0412 = ActiveSheet
Set xR0412 = Range(Sh0412.[A1], Sh0412.UsedRange): Brr0412 = xR0412
On Error Resume Next
Sheets("輔助表_WEB").Delete
On Error GoTo 0
With Sheets.Add
.Name = "輔助表_WEB"
.Visible = False
xR0412.Copy .[A1]
.UsedRange.ClearContents
.UsedRange = Brr0412
End With
End Sub
'===============================
Sub 比對_不同值變底色()
Dim Brr, xR As Range, i&, j%, xU As Range
Set xR = Range(Sh0412.[A1], Sh0412.UsedRange): Brr = xR
Set xU = Sh0412.[A1]
For i = 1 To UBound(Brr0412)
For j = 1 To UBound(Brr0412, 2)
   If Brr(i, j) <> Brr0412(i, j) Then
      Set xU = Union(xU, xR(i, j))
   End If
Next
Next
xR.Interior.ColorIndex = xlNone
xU.Interior.ColorIndex = 6
Set xU = Nothing: Set xR = Nothing: Set xR0412 = Nothing
Erase Brr, Brr0412
End Sub
'===============================
Sub 更新WEB資料()
'請植入必須更新的程式碼
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

coafort