123
返回列表 上一主題 發帖

[發問] 請大師們幫忙自動變換顏色,謝謝

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-5-8 18:27 | 只看該作者

[發問] 請大師們幫忙自動變換顏色,謝謝

請教各位大師

我想要依"公司清單"這個sheet裡列的公司,讓"設備列表"這個sheet裡面的設備自動整列變色成為"公司清單"sheet內對應的顏色
因本身對顏色辨識能力較弱,其望可以有相應的色碼以供辨識
希望能相容於excel 2003~2010
請各位大師幫忙,感謝
測試檔案.zip (3.97 KB)
收藏 分享
天天空空啊~

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2015-5-9 06:55 | 只看該作者
請教各位大師

我想要依"公司清單"這個sheet裡列的公司,讓"設備列表"這個sheet裡面的設備自動整列變色成為 ...
leirex1201 發表於 2015-5-8 18:27

印象中在 Excel 2003 似乎沒有可直接抓取儲存格底色的公式.

你的需求用 Excel VBA 較容易達成:
  1. Private Sub cbGetColor_Click()
  2.   Dim lRow&
  3.   Dim vD
  4.   
  5.   Set vD = CreateObject("Scripting.Dictionary")

  7.   lRow = 2
  8.   With Sheets("公司清單")
  9.     Do While .Cells(lRow, 1) <> ""
  10.       vD(.Cells(lRow, 2).Text) = .Cells(lRow, 3).Interior.ColorIndex
  11.       lRow = lRow + 1
  12.     Loop
  13.   End With
  14.   
  15.   lRow = 2
  16.   With Sheets("設備列表")
  17.     Do While .Cells(lRow, 1) <> ""
  18.       .Rows(lRow).Interior.ColorIndex = vD(.Cells(lRow, 2).Text)
  19.       lRow = lRow + 1
  20.     Loop
  21.   End With
  22. End Sub
複製代碼
當檔案內容有更新時,點一下 "更新底色" 按鈕即可.
[attach]20896[/attach]

測試檔案-a.zip (11.89 KB)

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 2015-5-9 11:36 | 只看該作者
本帖最後由 lpk187 於 2015-5-9 11:38 編輯

回復 1# leirex1201

也可以用工作表事件來達成自動化
當B欄以後到E欄有變化時就會達成目的
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Row > 1 And Target.Column < 6 And Cells(Target.Row, 2) <> "" Then
  3.     Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
  4.     Range(Cells(Target.Row, 1), Cells(Target.Row, 1).End(xlToRight)).Interior.Color = _
  5.     col.Offset(0, 1).Interior.Color
  6. End If
  7. End Sub
複製代碼
測試檔案.rar (14.21 KB)

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
4#
發表於 2015-5-11 10:00 | 只看該作者
印象中在 Excel 2003 似乎沒有可直接抓取儲存格底色的公式.

你的需求用 Excel VBA 較容易達成:當檔案內 ...
luhpro 發表於 2015-5-9 06:55



感謝luhpro大師回覆

請問要貼到wookbook嗎?謝謝
天天空空啊~

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2015-5-11 10:05 | 只看該作者
本帖最後由 leirex1201 於 2015-5-11 10:07 編輯
回復  leirex1201

也可以用工作表事件來達成自動化
當B欄以後到E欄有變化時就會達成目的
lpk187 發表於 2015-5-9 11:36



感謝lpk187大師回覆

If Target.Row > 1 And Target.Column < 10 And Cells(Target.Row, 1) <> "" Then
以上是change的事件範圍嗎
Range(Cells(Target.Row, 1), Cells(Target.Row, 1).End(xlToRight)).Interior.Color = _
    col.Offset(0, 1).Interior.Color
但我不懂這個,
我想要設定變色的範圍,只要B欄位有值,不管後面的欄位有沒有值,比如A10~P10全部變色,請大師幫幫忙,謝謝
天天空空啊~

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-5-11 10:24 | 只看該作者
回復 5# leirex1201
只有B欄的話可以改成這樣
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Address = Cells(Target.Row, "B").Address Then
  3.     Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
  4.     Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Interior.Color = _
  5.     col.Offset(0, 1).Interior.Color
  6. End If
  7. End Sub
複製代碼

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2015-5-11 10:44 | 只看該作者
回復  leirex1201
只有B欄的話可以改成這樣
lpk187 發表於 2015-5-11 10:24


感謝lpk187大大再一次幫忙

可能是我說明的不清楚
我的意思是A2有值"1",B2有值"遠傳電信",而C2:K2都是空白,但我想把A2:K2全部變色,感謝大師
天天空空啊~

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
8#
發表於 2015-5-11 11:31 | 只看該作者
回復 7# leirex1201

嗯！那就改成下列
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Column < 3 And Target.Row > 1 And Cells(Target.Row, "B") <> "" And Cells(Target.Row, "A") <> "" Then
  3.     Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
  4.     Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Interior.Color = _
  5.     col.Offset(0, 1).Interior.Color
  6. End If
  7. End Sub
複製代碼

TOP

lpk187

帖子
552 
主題
3 
精華
0 
積分
578 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2024-7-9 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
9#
發表於 2015-5-11 11:41 | 只看該作者
回復 8# lpk187

改成下列的話，只要A欄和B欄其中一個無值的話回復空白
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Column < 3 And Target.Row > 1 And Cells(Target.Row, "B") <> "" And Cells(Target.Row, "A") <> "" Then
  3.     Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
  4.         AA = col.Offset(0, 1).Interior.Color
  5.     Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Interior.Color = _
  6.     col.Offset(0, 1).Interior.Color
  7. Else
  8.     Range(Cells(Target.Row, 1), Cells(Target.Row, 5)).Interior.Color = 16777215
  9. End If
  10. End Sub
複製代碼

TOP

leirex1201

帖子
20 
主題
5 
精華
0 
積分
29 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
10 
性別
男 
註冊時間
2014-1-27 
最後登錄
2020-7-8 

論壇榮譽勳章論壇贊助勳章
10#
發表於 2015-5-11 12:59 | 只看該作者
回復  lpk187

改成下列的話，只要A欄和B欄其中一個無值的話回復空白
lpk187 發表於 2015-5-11 11:41


感謝 lpk187 大師再次幫忙

不好意思,我可能還是沒表達清楚,我做了圖片如下
我想要達成如下圖這樣子,不管我在哪一column編輯,只要column(B)的值是符合"公司清單"sheet的值,那row(A2:K10)都變色
再次感謝^^
天天空空啊~

TOP

        靜思自在 : 一個缺口的杯子，如果換一個角度看它，它仍然是圓的。
123
返回列表 上一主題