標題: 希望大大幫忙一下下 如何標記 [打印本頁]

---

作者: lbs1252    時間: 2012-10-4 16:55     標題: 希望大大幫忙一下下 如何標記

各位大大好   小弟想請問一下  如何用巨集來標註顏色  
如附件    我想要讓品名為衣服 鞋子 的底色為黃色
                數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
               這樣該如何寫   麻煩各位大大[attach]12695[/attach]

---

作者: GBKEE    時間: 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

複製代碼

---

作者: lbs1252    時間: 2012-10-5 14:04

感謝大大小弟馬上試試

---

作者: lbs1252    時間: 2012-10-5 14:09

板大謝謝你   不過關於品名方面的顏色小弟該如何設定   萬分感激

---

作者: lbs1252    時間: 2012-10-5 15:34

小弟找到方法了   感恩阿

---

作者: hugh0620    時間: 2012-10-5 15:37

利用G大的來修改~

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4. 
   
5.     Dim Rng As Range, C As Integer, Font_Color As Integer
   
6. 
   
7.     Set Rng = Sheets("東運－資料範例").[D2]  '數量
   
8. 
   
9.     ' 數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
   
10. 
    
11.     Do
    
12. 
    
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
    
20. 
    
21.             Case 1 To 10       '數量 1-10的為紅色
    
22. 
    
23.                 C = 3
    
24. 
    
25.                 Font_Color = 6
    
26. 
    
27.             Case 11 To 20       '數量 11-20為綠色
    
28. 
    
29.                 C = 10
    
30. 
    
31.             Case 21 To 30       '數量 21-30為藍色
    
32. 
    
33.                 C = 5
    
34. 
    
35.                 Font_Color = 2
    
36. 
    
37.             Case 31 To 40       '數量 31-40為淡藍色
    
38. 
    
39.                 C = 8
    
40. 
    
41.             Case Else           '其餘數量
    
42. 
    
43.                 C = xlAutomatic
    
44. 
    
45.         End Select
    
46. 
    
47.         Rng.Interior.ColorIndex = C
    
48. 
    
49.         Rng.Font.ColorIndex = Font_Color
    
50. 
    
51.         Set Rng = Rng.Offset(1)   '數量 下移一列
    
52. 
    
53.     Loop While Rng <> ""        '離開 迴圈 : 數量=""
    
54. 
    
55. End Sub

複製代碼

回復 4# lbs1252

---

作者: lbs1252    時間: 2012-10-5 17:30

大大小弟在請問一下
如果我只要衣服被標記起來  那它數量才會被標記起來但顏色要不同該如何做
如衣服被標記黃色    那它的數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
鞋子被標記為灰色    那它的數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
  在麻煩大大了

---

作者: hugh0620    時間: 2012-10-5 18:02

不知道這樣是不是你要的結果~

1. Sub Ex()
   
2. 
   
3. 
   
4.     Dim Rng As Range, C As Integer, Font_Color As Integer
   
5. 
   
6. 
   
7.     Set Rng = Sheets("東運－資料範例").[D2]  '數量
   
8. 
   
9. 
   
10.     ' 數量1-10的為紅色   11-20為綠色 21-30為藍色 31-40為淡藍色
    
11. 
    
12. 
    
13.     Do
    
14. 
    
15. 
    
16.         Font_Color = xlAutomatic  '字體顏色
    
17. 
    
18.         
    
19. 
    
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. '===加這一段判斷品名的顏色，如果沒有符合品名的~ 其數量就不標顏色
    
28. 
    
29.         Select Case Rng.Value
    
30. 
    
31. 
    
32.             Case 1 To 10       '數量 1-10的為紅色
    
33. 
    
34. 
    
35.                 C = 3
    
36. 
    
37. 
    
38.                 Font_Color = 6
    
39. 
    
40. 
    
41.             Case 11 To 20       '數量 11-20為綠色
    
42. 
    
43. 
    
44.                 C = 10
    
45. 
    
46. 
    
47.             Case 21 To 30       '數量 21-30為藍色
    
48. 
    
49. 
    
50.                 C = 5
    
51. 
    
52. 
    
53.                 Font_Color = 2
    
54. 
    
55. 
    
56.             Case 31 To 40       '數量 31-40為淡藍色
    
57. 
    
58. 
    
59.                 C = 8
    
60. 
    
61. 
    
62.             Case Else           '其餘數量
    
63. 
    
64. 
    
65.                 C = xlAutomatic
    
66. 
    
67. 
    
68.         End Select
    
69. 
    
70. 
    
71.         Rng.Interior.ColorIndex = C
    
72. 
    
73. 
    
74.         Rng.Font.ColorIndex = Font_Color
    
75. 
    
76. 1
    
77.         Set Rng = Rng.Offset(1)   '數量 下移一列
    
78. 
    
79. 
    
80.     Loop While Rng <> ""        '離開 迴圈 : 數量=""
    
81. 
    
82. 
    
83. End Sub

複製代碼

回復 7# lbs1252

---

作者: lbs1252    時間: 2012-10-5 18:11

大大是這樣沒錯
過若我想改變品名的位置我該如何改變
感謝教導

---

作者: GBKEE    時間: 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

複製代碼

---

作者: lbs1252    時間: 2012-10-5 18:44

大大我弄出來還是不行   我在上傳壹次檔案麻煩大大們了[attach]12706[/attach]

---

作者: lbs1252    時間: 2012-10-5 21:25

真是抱歉阿    各位大大以及版大    小弟找出原因了     真是受教了   
我找出原因了感恩感恩萬分感謝

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)