返回列表 上一主題 發帖

[發問] 求救自動選色及填色~

leirex1201

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

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

[發問] 求救自動選色及填色~

請各位專家幫幫忙~萬分感謝
求救.zip (15.2 KB)
收藏 分享
天天空空啊~

leirex1201

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

論壇榮譽勳章論壇贊助勳章
2#
發表於 2014-1-28 08:16 | 只看該作者
請各位專家幫忙指導一下~感謝
天天空空啊~

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2014-1-28 10:19 | 只看該作者
本帖最後由 Hsieh 於 2014-1-28 23:47 編輯

回復 2# leirex1201


    基本上格式顏色無法使用基本功能選擇顏色
必須利用VBA輔助才能達成
Thisworkbook模組程式碼
  1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  2. Dim A As Range
  3. Application.EnableEvents = False
  4. With Target
  5.   If Sh.Cells(1, .Column) = "顏色" Then
  6.     Set A = Sheets("公司清單").[H:H].Find(Target, lookat:=xlWhole)
  7.     If Not A Is Nothing Then _
  8.     .Interior.ColorIndex = A.Interior.ColorIndex: .Offset(, 1) = A.Offset(, -1)
  9.   End If
  10.   DrowCell
  11. End With
  12. Application.EnableEvents = True
  13. End Sub
  14. Sub DrowCell()
  15. Dim A As Range, C As Range
  16. With Sheets("公司清單")
  17. For Each Sh In Sheets
  18.    If Sh.Name <> .Name Then
  19.    Set A = Sh.Rows(1).Find("所屬公司", lookat:=xlWhole)
  20.    For Each C In Sh.Range(A.Offset(1, 0), A.End(xlDown))
  21.       If Not .[C:C].Find(C, lookat:=xlWhole) Is Nothing Then _
  22.       C.Interior.ColorIndex = .[C:C].Find(C, lookat:=xlWhole).Offset(, 1).Interior.ColorIndex _
  23.       Else C.Interior.ColorIndex = xlNone
  24.    Next
  25.    End If
  26. Next
  27. End With
  28. End Sub
複製代碼
求救.rar (25.76 KB)
學海無涯_不恥下問

TOP

leirex1201

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

論壇榮譽勳章論壇贊助勳章
4#
發表於 2014-1-29 16:09 | 只看該作者
真是非常感謝板主的幫忙,按照板主的程式真的可以變色,但是沒有整列變色~請板主再指導一下,謝謝
天天空空啊~

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
5#
發表於 2014-2-6 07:38 | 只看該作者
試試看
  1. Sub 前景顏色代號_Change()
  2.    ActiveCell = Range("D2")
  3.    ActiveCell.Offset(, -1).Font.ColorIndex = ActiveCell
  4. End Sub

  6. Sub 背景顏色代號_Change()
  7.    ActiveCell = Range("E2")
  8.    ActiveCell.Offset(, -2).Interior.ColorIndex = ActiveCell
  9. End Sub

  11. Private Sub cmd填色_Click()
  12.    'ActiveCell 須在 欄10 和 欄16 之間
  13.    '按鈕 cmd填色 才有作用
  14.    col1 = ActiveCell.Column
  15.    If col1 < 10 Or col1 > 16 Then Exit Sub
  16.    
  17.    起點 = ActiveCell.Row
  18.    終點 = Cells(起點, 13).End(xlDown).Row
  19.    
  20.    'c欄 公司代表名稱 的總數
  21.    c代號總數 = [C3].End(xlDown).Row
  22.    
  23.    For mRow = 起點 To 終點
  24.       m代號 = UCase(Cells(mRow, 13))
  25.       For cRow = 3 To c代號總數
  26.          c代號 = Cells(cRow, 3)
  27.          If m代號 = c代號 Then
  28.             前景 = Cells(cRow, 4)
  29.             背景 = Cells(cRow, 5)
  30.             Cells(mRow, 10).Resize(, 7).Select
  31.             Selection.Interior.ColorIndex = 背景
  32.             Selection.Font.ColorIndex = 前景
  33.             Exit For
  34.          End If
  35.       Next
  36.    Next
  37. End Sub
複製代碼

TOP

leirex1201

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

論壇榮譽勳章論壇贊助勳章
6#
發表於 2016-6-7 14:42 | 只看該作者
回復 5# yen956

感謝yen956大大的幫忙
天天空空啊~

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
返回列表 上一主題