12
返回列表 上一主題 發帖

希望大大幫忙一下下 如何標記

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-10-4 16:55 | 只看該作者

希望大大幫忙一下下 如何標記

各位大大好   小弟想請問一下  如何用巨集來標註顏色  
如附件    我想要讓品名為衣服 鞋子 的底色為黃色
                數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
               這樣該如何寫   麻煩各位大大 123.rar (10.94 KB)
收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2012-10-5 09:04 | 只看該作者
回復 1# lbs1252
用工作表指令 格式->設定格式化條件, 也可達到你的期望.
VBA程式碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, C As Integer, Font_Color As Integer
  4.     Set Rng = Sheets("東運－資料範例").[D2]  '數量
  5.     ' 數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
  6.     Do
  7.         Font_Color = xlAutomatic  '字體顏色
  8.         Select Case Rng.Value
  9.             Case 1 To 10       '數量 1-10的為紅色
  10.                 C = 3
  11.                 Font_Color = 6
  12.             Case 11 To 20       '數量 11-20為綠色
  13.                 C = 10
  14.             Case 21 To 30       '數量 21-30為藍色
  15.                 C = 5
  16.                 Font_Color = 2
  17.             Case 31 To 40       '數量 31-40為淡藍色
  18.                 C = 8
  19.             Case Else           '其餘數量
  20.                 C = xlAutomatic
  21.         End Select
  22.         Rng.Interior.ColorIndex = C
  23.         Rng.Font.ColorIndex = Font_Color
  24.         Set Rng = Rng.Offset(1)   '數量 下移一列
  25.     Loop While Rng <> ""        '離開 迴圈 : 數量=""
  26. End Sub
複製代碼

TOP

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
3#
發表於 2012-10-5 14:04 | 只看該作者
感謝大大小弟馬上試試

TOP

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
4#
發表於 2012-10-5 14:09 | 只看該作者
板大謝謝你   不過關於品名方面的顏色小弟該如何設定   萬分感激

TOP

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
5#
發表於 2012-10-5 15:34 | 只看該作者
小弟找到方法了   感恩阿

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
6#
發表於 2012-10-5 15:37 | 只看該作者
利用G大的來修改~
  1. Option Explicit

  3. Sub Ex()

  5.     Dim Rng As Range, C As Integer, Font_Color As Integer

  7.     Set Rng = Sheets("東運－資料範例").[D2]  '數量

  9.     ' 數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色

  11.     Do

  13.         Font_Color = xlAutomatic  '字體顏色
  14.         
  15. If Rng.Offset(0, -2) = "衣服" Or Rng.Offset(0, -2) = "鞋子" Then
  16.     Rng.Offset(0, -2).Interior.ColorIndex = 6
  17. End If
  18. '===加這一段判斷品名的顏色
  19.         Select Case Rng.Value

  21.             Case 1 To 10       '數量 1-10的為紅色

  23.                 C = 3

  25.                 Font_Color = 6

  27.             Case 11 To 20       '數量 11-20為綠色

  29.                 C = 10

  31.             Case 21 To 30       '數量 21-30為藍色

  33.                 C = 5

  35.                 Font_Color = 2

  37.             Case 31 To 40       '數量 31-40為淡藍色

  39.                 C = 8

  41.             Case Else           '其餘數量

  43.                 C = xlAutomatic

  45.         End Select

  47.         Rng.Interior.ColorIndex = C

  49.         Rng.Font.ColorIndex = Font_Color

  51.         Set Rng = Rng.Offset(1)   '數量 下移一列

  53.     Loop While Rng <> ""        '離開 迴圈 : 數量=""

  55. End Sub
複製代碼
回復 4# lbs1252
學習才能提升自己

TOP

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
7#
發表於 2012-10-5 17:30 | 只看該作者
大大小弟在請問一下
如果我只要衣服被標記起來  那它數量才會被標記起來但顏色要不同該如何做
如衣服被標記黃色    那它的數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
鞋子被標記為灰色    那它的數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
  在麻煩大大了

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
8#
發表於 2012-10-5 18:02 | 只看該作者
不知道這樣是不是你要的結果~
  1. Sub Ex()


  4.     Dim Rng As Range, C As Integer, Font_Color As Integer


  7.     Set Rng = Sheets("東運－資料範例").[D2]  '數量


  10.     ' 數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色


  13.     Do


  16.         Font_Color = xlAutomatic  '字體顏色

  18.         

  20. If Rng.Offset(0, -2) = "衣服" Then
  21.    Rng.Offset(0, -2).Interior.ColorIndex = 6
  22. ElseIf Rng.Offset(0, -2) = "鞋子" Then
  23.    Rng.Offset(0, -2).Interior.ColorIndex = 15
  24. Else
  25.   GoTo 1
  26. End If
  27. '===加這一段判斷品名的顏色，如果沒有符合品名的~ 其數量就不標顏色

  29.         Select Case Rng.Value


  32.             Case 1 To 10       '數量 1-10的為紅色


  35.                 C = 3


  38.                 Font_Color = 6


  41.             Case 11 To 20       '數量 11-20為綠色


  44.                 C = 10


  47.             Case 21 To 30       '數量 21-30為藍色


  50.                 C = 5


  53.                 Font_Color = 2


  56.             Case 31 To 40       '數量 31-40為淡藍色


  59.                 C = 8


  62.             Case Else           '其餘數量


  65.                 C = xlAutomatic


  68.         End Select


  71.         Rng.Interior.ColorIndex = C


  74.         Rng.Font.ColorIndex = Font_Color

  76. 1
  77.         Set Rng = Rng.Offset(1)   '數量 下移一列


  80.     Loop While Rng <> ""        '離開 迴圈 : 數量=""


  83. End Sub
複製代碼
回復 7# lbs1252
學習才能提升自己

TOP

lbs1252

帖子
18 
主題
6 
精華
0 
積分
29 
點名
0  
作業系統
XP 
軟體版本
OFFUCE 2003 
閱讀權限
10 
性別
男 
來自
台灣台北 
註冊時間
2012-8-29 
最後登錄
2016-7-17 

論壇贊助勳章
9#
發表於 2012-10-5 18:11 | 只看該作者
大大是這樣沒錯
過若我想改變品名的位置我該如何改變
感謝教導

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2012-10-5 18:34 | 只看該作者
本帖最後由 GBKEE 於 2012-10-5 18:36 編輯

回復 9# lbs1252
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, C As Integer, Font_Color As Integer
  4.     Set Rng = Sheets("東運－資料範例").[B2]     '品名
  5.     Do
  6.         If Rng = "衣服" And Rng.Interior.ColorIndex = 6 Or _
  7.          Rng = "鞋" And Rng.Interior.ColorIndex = 15 Then  'Rng = "衣服" AND(且) 圖樣.顏色值= 6(黃色)  OR(或)  Rng = "鞋" AND(且) 圖樣.顏色值= 15(灰色)
  8.                                                            '1#的檔案 品名 是 "鞋"  非 "鞋子"
  9.             Font_Color = xlAutomatic            '字體顏色
  10.             Select Case Rng.Offset(, 2).Value   '品名 右移2欄為 數量
  11.                 Case 1 To 10                    '數量 1-10的為紅色
  12.                     C = 3
  13.                     Font_Color = 6
  14.                 Case 11 To 20                   '數量 11-20為綠色
  15.                     C = 10
  16.                 Case 21 To 30                   '數量 21-30為藍色
  17.                     C = 5
  18.                     Font_Color = 2
  19.                 Case 31 To 40                   '數量 31-40為淡藍色
  20.                     C = 8
  21.                 Case Else                       '其餘數量
  22.                     C = xlAutomatic
  23.             End Select
  24.             Rng.Offset(, 2).Interior.ColorIndex = C
  25.             Rng.Offset(, 2).Font.ColorIndex = Font_Color
  26.         End If
  27.         Set Rng = Rng.Offset(1)                 '品名 下移一列
  28.     Loop While Rng <> ""                        '離開 迴圈 : 品名=""
  29. End Sub
複製代碼

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
12
返回列表 上一主題