[發問] (已解決)統計顏色次數

freeffly

如果我有一個資料是用當月價格比較上次交易價格
當價格較低時會標上顏色
要用什麼方式可以計算出該列的顏色出現次數
就是該產品降價次數?

新增 Microsoft Excel 工作表 (3).rar (1.63 KB)

下載次數: 14

2011-5-18 22:09

chin15

Sub ccount()
Dim c As Range, d$, d2$, m%
    Application.FindFormat.Font.ColorIndex = 7
    Set c = Cells.Find(What:="", After:=[a1], SearchDirection:=xlNext, SearchFormat:=True)
    If Not c Is Nothing Then
        d = c.Address
        Do
            d2 = c.Address
            m = m + 1
            Set c = Cells.Find(What:="", After:=Range(d2), SearchDirection:=xlNext, SearchFormat:=True)
        Loop Until c.Address = d
    End If
    [l1] = m
End Sub

freeffly

回復 2# chin15


    可能發帖的時候沒說很清楚
   我想要的結果統計各商品的跌價次數
   如附檔
   大大的方式是統計所有顏色的出現次數
   不知道我的想法有沒有方式可以完成?


新增 Microsoft Excel 工作表 (3).rar (7.15 KB)

下載次數: 17

2011-5-19 07:43

GBKEE

回復 3# freeffly

1. Sub Ex()
   
2.     Dim Rng As Range, X As Range, R As Range, Tolta%, A%, i%, ii%
   
3.     Cells.ClearFormats
   
4.     Set Rng = Range("B2:I" & [A2].End(xlDown).Row)
   
5.     For Each R In Rng.Rows
   
6.         Set Rng = R.Cells(1)
   
7.         A = 0
   
8.         For ii = 2 To 8
   
9.             If R.Cells(1, ii) <> "" And Rng > R.Cells(1, ii) Then
   
10.                 Set Rng = R.Cells(1, ii)
    
11.                 R.Cells(1, ii).Font.ColorIndex = 7
    
12.                 Tolta = Tolta + 1
    
13.                 A = A + 1
    
14.                 With R.Cells(1, 10)
    
15.                     .Value = A
    
16.                     .Interior.ColorIndex = 4
    
17.                 End With
    
18.             ElseIf R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
    
19.                 Set Rng = R.Cells(1, ii)
    
20.             End If
    
21.         Next
    
22.     Next
    
23.     [L1] = Tolta
    
24. End Sub

複製代碼

freeffly

回復 4# GBKEE


    這是我要的結果
     謝謝大大的回覆

freeffly

回復 4# GBKEE

   這兩天拿出來研究時發現有些程式碼用法不太懂

    Sub Ex()
    Dim Rng As Range, X As Range, R As Range, Tolta%, A%, i%, ii%
    Cells.ClearFormats
    Set Rng = Range("B2:I" & [A2].End(xlDown).Row)
    For Each R In Rng.Rows
        Set Rng = R.Cells(1)       R.Cells(1)→這個是指?        A = 0
        For ii = 2 To 8
            If R.Cells(1, ii) <> "" And Rng > R.Cells(1, ii) Then      R.Cells(1, ii)這個跟上面問的差異在哪?
                Set Rng = R.Cells(1, ii)
                R.Cells(1, ii).Font.ColorIndex = 7
                Tolta = Tolta + 1
                A = A + 1
                With R.Cells(1, 10)
                    .Value = A
                    .Interior.ColorIndex = 4
                End With
            ElseIf R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
                Set Rng = R.Cells(1, ii)                                   這一整句的意思是?
            End If
        Next
    Next
    [L1] = Tolta
End Sub



如果我要將降價改為漲價是不是寫法不太依樣還是修改什麼地方可以達到效果?

GBKEE

回復 6# freeffly
  For Each R In Rng.Rows         R-> Rng每一整列範圍         
        Set Rng = R.Cells(1)       R.Cells(1)→  R這列範圍的裡第1個Cell
                                               R.Cells(2)→  R這列範圍的裡第2個Cell

  For Each R In Rng.Columns          R-> Rng每一整欄範圍         
         Set Rng = R.Cells(1, ii)          R.Cells(1, ii)→  R這欄範圍的裡第1列,第 ii欄的Cell
                                                      R.Cells(2, ii)→  R這欄範圍的裡第2列,第 ii欄的Cell

freeffly

回復 7# GBKEE


    謝謝大大解說
     我在研究一下如何改成漲價的判斷

freeffly

回復 7# GBKEE

1. Sub up()
   
2.     Application.ScreenUpdating = False
   
3.     Dim Rng As Range, X As Range, R As Range, Tolta%, A%, i%, ii%
   
4.     With Cells.Font
   
5.         .ColorIndex = 0
   
6.         .Bold = False
   
7.     End With
   
8.     Set Rng = Range("C5:AD" & [A65536].End(xlUp).Row)
   
9.     For Each R In Rng.Rows
   
10.         Set Rng = R.Cells(1)
    
11.         A = 0
    
12.         Y = [iv4].End(xlToLeft).Column - 1
    
13.         For ii = 2 To 28
    
14.             If R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
    
15.                 Set Rng = R.Cells(1, ii)
    
16.                 With R.Cells(1, ii).Font
    
17.                     .ColorIndex = 7
    
18.                     .Bold = True
    
19.                 End With
    
20.                 A = A + 1
    
21.                 With R.Cells(1, Y)
    
22.                     .Value = A
    
23.                     .Interior.ColorIndex = 4
    
24.                 End With
    
25.             ElseIf R.Cells(1, ii) <> "" And Rng > R.Cells(1, ii) Then
    
26.                 Set Rng = R.Cells(1, ii)
    
27.             End If
    
28.             If R.Cells(1) = "" Then
    
29.             With R.Cells(2).Font
    
30.                 .ColorIndex = 0
    
31.                 .Bold = False
    
32.            End With
    
33.            End If
    
34.         Next
    
35.     Next
    
36. End Sub

複製代碼

1.    If R.Cells(1) = "" Then
   
2.             With R.Cells(2).Font
   
3.                 .ColorIndex = 0
   
4.                 .Bold = False
   
5.            End With
   
6.            End If

複製代碼

這一段原本是為了如果該行的第一格為空白第2格就不要做反應
可是我忘了還有第3、4....格
請問這各要怎麼修改?

freeffly

如附檔中標註的那兩各位子
要怎樣讓程式碼不對這種情形做動作可是又不會影響到他後面的數字做動作

Book1.rar (3.96 KB)

下載次數: 11

2011-5-27 17:42