返回列表 上一主題 發帖

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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
1# 跳轉到 »
發表於 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

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 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

        靜思自在 : 每天無所事事，是人生的消費者，積極、有用才是人生的創造者。
返回列表 上一主題