帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2012-4-7 11:11 | 只看該作者

[發問] 如何判斷找出資料並標示不同顏色

本帖最後由 luke 於 2012-4-7 14:01 編輯

各位大大

小弟想在sheet1表A:B兩欄任一儲存格輸入資料後, 自動去比對sheet2 兩個資料區,

當sheet1表A欄輸入資料後就需檢查sheet2表第1個資料區A:B欄(黃色區), 若資料內容格式相同即做同底色處理, 若資料不相同就把該筆資料改成紅色

同理, 當sheet1表B欄輸入資料後就需檢查sheet2表第2個資料區C:D欄(藍色區), 若資料內容格式相同即做同底色處理, 若資料不相同就把該筆資料改成紅色

煩請先進指導

TEST8.rar (13.65 KB)

樓主熱帖

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2012-4-7 12:57 | 只看該作者

回復 1# luke

沒附檔案?

工作表模組

Private Sub worksheet_change(ByVal target As Range)
If target.Column <= 2 Then
LR = Sheet2.[A1].End(xlDown).Row
Set Rng = Sheet2.Range(Sheet2.Cells(1, target.Column * 2 - 1), Sheet2.Cells(LR, target.Column * 2))
Set X = Rng.Find(target, , , xlWhole)
If X Is Nothing Then
target.Interior.ColorIndex = 3
Else
target.Interior.ColorIndex = X.Interior.ColorIndex
End If
End If
End Sub

複製代碼

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

3^#

發表於 2012-4-7 14:11 | 只看該作者

回復 2# register313

檔案已上傳

煩請指導

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

4^#

發表於 2012-4-7 14:28 | 只看該作者

回復 3# luke

儲存格須逐格輸入

工作表sheet1模組

Private Sub worksheet_change(ByVal target As Range)
If target.Column <= 2 Then
LR = Sheet2.[A1].End(xlDown).Row
Set Rng = Sheet2.Range(Sheet2.Cells(1, target.Column * 2 - 1), Sheet2.Cells(LR, target.Column * 2))
Set X = Rng.Find(target, , , xlWhole)
If X Is Nothing Then
target.Font.ColorIndex = 3
Else
target.Interior.ColorIndex = X.Interior.ColorIndex
End If
End If
End Sub

複製代碼

TOP

register313

　頭銜: 麻辣路人甲

大學生 Rank: 4

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

5^#

發表於 2012-4-7 14:37 | 只看該作者

回復 3# luke

儲存格已先全部輸入好,一次判斷全部儲存格

一般模組

Sub xx()
For Each target In [A1].CurrentRegion
If target.Column <= 2 Then
LR = Sheet2.[A1].End(xlDown).Row
Set Rng = Sheet2.Range(Sheet2.Cells(1, target.Column * 2 - 1), Sheet2.Cells(LR, target.Column * 2))
Set X = Rng.Find(target, , , xlWhole)
If X Is Nothing Then
target.Font.ColorIndex = 3
Else
target.Interior.ColorIndex = X.Interior.ColorIndex
End If
End If
Next
End Sub

複製代碼

TOP

luke

中學生 Rank: 2

帖子: 140
主題: 37
精華: 0
積分: 193
點名: 0
作業系統: Windows XP
軟體版本: Office 2007
閱讀權限: 20
註冊時間: 2012-3-28
最後登錄: 2015-7-5

2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章

6^#

發表於 2012-4-8 13:30 | 只看該作者

回復 5# register313

兩個程式測試OK

謝謝register313

TOP