[發問] 關於篩選與其背景顏色設定問題

mark15jill

想請問一下 就是有關於篩選和背景顏色的問題
因為我想設定不同人就有不同的背景顏色
想請問 假使 每種都要不同的背景顏色
那要如何去判斷
小弟有試著去寫
但是卻都只會呈現一種
格式例如
a        b        c
1        1        1
2        2        2
3        3        3
4        4        4
5        5        5
6        6        6
7        7        7
8        8        8
9        9        9
10        10        10
11        11        11
12        12        12
13        13        13
14        14        14
15        15        15
16        16        16
17        17        17
18        18        18
19        19        19

例如在VBA直接將 篩選的條件改為C7的話 背景為紅色
在VBA直接將 篩選的條件改為C9的話 背景為紫色

Hsieh

回復 1# mark15jill
顏色給個規則做成列表
用SUBTOTAL來觸發Worksheet_Calculate事件
如圖

下載 (17.5 KB)

2011-4-18 22:20

mark15jill

版主 我知道您說的意思
可是 因為這個部份是想說資料直接辨別出來(因有超過上千筆)
而且活頁簿也沒那個空間多出那個
所以才想說能否用一個通用的巨集寫出來
這樣才比較好辨識
感謝您

oobird

顏色只有56種
不能應付超過1000筆不同顏色的

mark15jill

不好意思 大概我沒把意思表達清楚
我重新表達一次
格式例如
a        b        c
1        1        Q
2        2        W
3        3        E
4        4        R
5        5        T
6        6        Q
7        7        W
8        8        E
9        9        R
10      10       T

而 C 的種類 只有5種
a和b資料筆數卻有上千筆
(好比有5個人 要處理 1千筆資料的意思)
謝謝

oobird

Sub yy()
    Dim x$, i%, c As Range
    x = "QWERT"
    With [c:c]
        For i = 1 To 5
            Set c = .Find(Mid(x, i, 1), [c65536], , 1)
            If Not c Is Nothing Then
                d = c.Address
                Do
                    c(1, -1).Resize(, 3).Interior.ColorIndex = i + 2
                    Set c = .FindNext(c)
                Loop Until c.Address = d
            End If
        Next
    End With
End Sub

GBKEE

Sub yy()
    Dim x$, i%, c As Range
    x = "QWERT"
    For Each c In Range("c:c").SpecialCells(xlCellTypeConstants)
        i = InStr(x, UCase(c))
        If i Then c(1, -1).Resize(, 3).Interior.ColorIndex = i + 2
    Next
End Sub

mark15jill

謝謝兩位版主
想再請問一下 關於
x= "QWERT"    這點 是要直接設在一起?
那如果是中文的話 要怎區分呢?
另外 顏色設置這邊的話 interior.colorindex=i+2 這串是? 對不起真的不懂...

GBKEE

回復 8# mark15jill

1. Sub Ex()
   
2.     Dim x(), i, c As Range
   
3.     x = Array("陳一", "徐二", "張三", "李四", "王五")
   
4.     For Each c In Range("c:c").SpecialCells(xlCellTypeConstants)
   
5.         i = Application.Match(c, x, 0)
   
6.         If IsNumeric(i) Then c(1, -1).Resize(, 3).Interior.ColorIndex = i + 2  '色盤中的索引值
   
7.     Next
   
8. End Sub

複製代碼

Hsieh

2007版可使用Interior.Color屬性
利用字元碼來區別

1. Private Sub Worksheet_Calculate()
   
2. For r = 2 To Cells(Rows.Count, 3).End(xlUp).Row
   
3. For i = 1 To Len(Cells(r, 3))
   
4.    k = k + Asc(Cells(r, 3))
   
5. Next
   
6.    Cells(r, 1).Resize(, 3).Interior.Color = 10000000000# / k
   
7.    k = 0
   
8. Next
   
9. End Sub

複製代碼