返回列表 上一主題 發帖

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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
1# 跳轉到 »
發表於 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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
2#
發表於 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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
3#
發表於 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羊年全勤獎章熱烈參與勳章
4#
發表於 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

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
5#
發表於 2015-5-11 13:15 | 顯示全部帖子
回復 10# leirex1201

是只要A欄和B欄有值，然後從編輯的那一行A到K都變色對嗎？只要改紅字的部份就可以了
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 3 And Target.Row > 1 And Cells(Target.Row, "B") <> "" And Cells(Target.Row, "A") <> "" Then
    Set col = Sheets("公司清單").Columns(2).Find(Cells(Target.Row, 2), , , , , 2)
        AA = col.Offset(0, 1).Interior.Color
    Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Interior.Color = _
    col.Offset(0, 1).Interior.Color
Else
    Range(Cells(Target.Row, 1), Cells(Target.Row, 11)).Interior.Color = 16777215
End If
End Sub

TOP

lpk187

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

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
6#
發表於 2015-5-11 19:19 | 顯示全部帖子
回復 13# leirex1201

不用稱我大師，我也是初學者！

    說實在的以上的程式碼，我也是看到你的問題之後去做巨集，然後想出來的，而我找到的方法都沒辦法對應到RGB
但可以用RGB填入色彩，是否能對應到RGB色碼，就要請教其他大大們了！我找到的只有以下程式碼
Sub 巨集1()
Range("A1:A2").Interior.Color = RGB(0, 255, 1)'A1:A2儲存格填入色彩
Range("B1") = Range("A1").Interior.Color  '傳回A1物件的主要色彩
Range("B2") = Range("A2").Interior.ColorIndex    '傳回A2代表內景色彩
End Sub

TOP

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
返回列表 上一主題