返回列表 上一主題 發帖

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

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

本帖最後由 freeffly 於 2012-2-22 17:02 編輯

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

新增 Microsoft Excel 工作表 (3).rar (1.63 KB)
字典兩各字 還真難理解

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

TOP

回復 2# chin15


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


新增 Microsoft Excel 工作表 (3).rar (7.15 KB)
字典兩各字 還真難理解

TOP

本帖最後由 GBKEE 於 2011-5-19 13:36 編輯

回復 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
複製代碼

TOP

回復 4# GBKEE


    這是我要的結果
     謝謝大大的回覆
字典兩各字 還真難理解

TOP

回復 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



如果我要將降價改為漲價是不是寫法不太依樣還是修改什麼地方可以達到效果?
字典兩各字 還真難理解

TOP

本帖最後由 GBKEE 於 2011-5-25 21:28 編輯

回復 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

TOP

回復 7# GBKEE


    謝謝大大解說
     我在研究一下如何改成漲價的判斷
字典兩各字 還真難理解

TOP

回復 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....格
請問這各要怎麼修改?
字典兩各字 還真難理解

TOP

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

Book1.rar (3.96 KB)
字典兩各字 還真難理解

TOP

        靜思自在 : 【為善競爭】人生要為善競爭,分秒必爭。
返回列表 上一主題