麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] (已解決)統計顏色次數 [打印本頁]

作者: freeffly 時間: 2011-5-18 22:10 標題: (已解決)統計顏色次數

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

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

[attach]6261[/attach]

作者: chin15 時間: 2011-5-18 22:56

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 時間: 2011-5-19 07:43

回復 2# chin15

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

[attach]6263[/attach]

作者: GBKEE 時間: 2011-5-19 09:13

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

回復 3# freeffly

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)
A = 0
For ii = 2 To 8
If R.Cells(1, ii) <> "" And Rng > R.Cells(1, ii) Then
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

複製代碼

作者: freeffly 時間: 2011-5-20 12:29

回復 4# GBKEE

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

作者: freeffly 時間: 2011-5-25 21:06

回復 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 時間: 2011-5-25 21:20

本帖最後由 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

作者: freeffly 時間: 2011-5-27 14:53

回復 7# GBKEE

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

作者: freeffly 時間: 2011-5-27 17:38

回復 7# GBKEE

Sub up()
Application.ScreenUpdating = False
Dim Rng As Range, X As Range, R As Range, Tolta%, A%, i%, ii%
With Cells.Font
.ColorIndex = 0
.Bold = False
End With
Set Rng = Range("C5:AD" & [A65536].End(xlUp).Row)
For Each R In Rng.Rows
Set Rng = R.Cells(1)
A = 0
Y = [iv4].End(xlToLeft).Column - 1
For ii = 2 To 28
If R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
Set Rng = R.Cells(1, ii)
With R.Cells(1, ii).Font
.ColorIndex = 7
.Bold = True
End With
A = A + 1
With R.Cells(1, Y)
.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
If R.Cells(1) = "" Then
With R.Cells(2).Font
.ColorIndex = 0
.Bold = False
End With
End If
Next
Next
End Sub

複製代碼

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

複製代碼

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

作者: freeffly 時間: 2011-5-27 17:43

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

[attach]6359[/attach]

作者: GBKEE 時間: 2011-5-27 19:55

回復 9# freeffly
"可是我忘了還有第3、4....格 " 沒有啊
Y = [iv4].End(xlToLeft).Column - 1 作何用??
10樓的附檔不符合用於9樓的程式

回復10# freeffly

這條件請還要詳述

作者: freeffly 時間: 2011-5-30 12:24

回復 11# GBKEE

如附檔黃色標起來的地方不應該被認為漲價
因為前面沒交易
你提的那行程式碼我是要用來讓他直接在資料的右邊統計
[attach]6409[/attach]

作者: freeffly 時間: 2011-5-31 19:46

不知道我的附檔大大看的懂嗎?

作者: GBKEE 時間: 2011-6-1 20:15

回復 13# freeffly

是這樣嗎?

Sub up()
Application.ScreenUpdating = False
Dim Rng As Range, R As Range, i%, ii%
With Cells
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
Set Rng = Range("C5:AD" & [A65536].End(xlUp).Row)
For Each R In Rng.Rows
A = 0
Set Rng = R.Cells(1, 0).End(xlToRight)
Rng.Interior.ColorIndex = 6
For ii = Rng.Column - 1 To 28
If R.Cells(ii) <> "" And Rng < R.Cells(ii) Then
Set Rng = R.Cells(ii)
With R.Cells(ii).Font
.ColorIndex = 7
.Bold = True
End With
A = A + 1
ElseIf R.Cells(ii) <> "" And Rng > R.Cells(ii) Then
Set Rng = R.Cells(ii)
End If
Next
With R.Cells(1, 29)
.Value = A
.Interior.ColorIndex = 4
End With
Next
Set Rng = Nothing
Set R = Nothing
End Sub

複製代碼

作者: freeffly 時間: 2011-6-1 22:00

回復 14# GBKEE

表達上可能有些不清楚
不過大大的方式我改過已經是我要的

只是不知道我這樣改事不是最佳的方式
附上我要的完成品
又學到新東西
謝謝

Sub up()
Application.ScreenUpdating = False
Dim Rng As Range, X As Range, R As Range, Tolta%, A%, i%, ii%
With Cells
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
Set Rng = Range("C5:AD" & [A65536].End(xlUp).Row)
For Each R In Rng.Rows
Set Rng = R.Cells(1)
A = 0
Set Rng = R.Cells(1, 0).End(xlToRight)
Rng.Interior.ColorIndex = 0
Y = [iv4].End(xlToLeft).Column - 1
For ii = 2 To 28
If R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
Set Rng = R.Cells(1, ii)
With R.Cells(1, ii).Font
.ColorIndex = 7
.Bold = True
End With
A = A + 1
With R.Cells(1, Y)
.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
End Sub

複製代碼

[attach]6456[/attach]

作者: Hsieh 時間: 2011-6-3 09:55

回復 15# freeffly

直接判斷數值是否增加

Sub ex()
[AE:AE] = ""
R = 5
Do Until Cells(R, 2) = ""
Set Rng = Range(Cells(R, 3), Cells(R, "AD"))
i = 1
Do Until Rng(1, i) <> ""
i = i + 1
Loop
first = Rng(1, i): i = i + 1
For k = i To Rng.Count
If Rng(1, k) > first Then cnt = cnt + 1
If Rng(1, k) <> "" Then first = Rng(1, k)
Next
Cells(R, "AE") = cnt: cnt = 0
R = R + 1
Loop
End Sub

複製代碼

作者: freeffly 時間: 2011-6-4 07:26

回復 16# Hsieh

謝謝大大提供另外一種方式
這個的迴圈好幾層
感覺都快亂了→對我而言
可以問一下這兩句的意思嗎
first = Rng(1, i): i = i + 1
Cells(R, "AE") = cnt: cnt = 0

剩下的程式碼拆開都看得懂
不過還需要理解

作者: Hsieh 時間: 2011-6-4 08:21

回復 17# freeffly

Sub ex()
[AE:AE] = ""
R = 5'第5列開始
Do Until Cells(R, 2) = ""
Set Rng = Range(Cells(R, 3), Cells(R, "AD"))'C:AD欄的列範圍
i = 1
Do Until Rng(1, i) <> ""'找到該列的第一個數值位置
i = i + 1
Loop
first = Rng(1, i): i = i + 1'把第一個數值記住，準備從第一個數值後開始找數值
For k = i To Rng.Count
If Rng(1, k) > first Then cnt = cnt + 1'如果儲存格數值比前一個數值大，計數的變數就加1
If Rng(1, k) <> "" Then first = Rng(1, k)'如果不是空格，就把儲存格的值記住，準備跟下一個數值做比較
Next
Cells(R, "AE") = cnt: cnt = 0'整列跑完後，就把計數的值填入，然後歸零
R = R + 1'下一列
Loop
End Sub

作者: freeffly 時間: 2011-6-6 20:29

回復 18# Hsieh

謝謝大大花時間解說
那兩句的寫法對我來說還需要花時間裡解

作者: sammyshain 時間: 2012-8-21 14:57

真的好厲害~

作者: c_c_lai 時間: 2012-8-21 16:37

回復 4# GBKEE

Set Rng = Range("B2:I" & [A2].End(xlDown).Row)
For Each R In Rng.Rows
Set Rng = R.Cells(1)

複製代碼

您為何不寫成？

Set Rng = Range("B2:I" & [A2].End(xlDown).Row)
For Each R In Rng.Rows
Set X = R.Cells(1)

複製代碼

作者: GBKEE 時間: 2012-8-21 20:11

回復 21# c_c_lai
Set X = R.Cells(1) 在程序中是會表達明確些 , 不修改它在這程序中一樣達到效果,
程式中也 Dim X As Range 應因是一時忘記用它吧!
謝謝你的提醒,糾正.

作者: c_c_lai 時間: 2012-8-22 07:46

回復 22# GBKEE
我的本意是：
[attach]12219[/attach]
請您別介意，莫說糾正一詞了！

作者: GBKEE 時間: 2012-8-22 08:12

回復 23# c_c_lai

Option Explicit
Sub Ex()
Dim Rng As Integer, i As Integer, x As Integer
Rng = 10
i = 0
For x = 1 To Rng '這裡迴圈最終值已設定=10 不受以後的影響
Debug.Print x '請在即時視窗看 x 的變動
i = i + 1
Rng = i + 5 'Rng變數不影響迴圈最終值
x = Rng '這 X變數才會影響迴圈的次數
Next
MsgBox "迴圈迴結束後 X= " & x
End Sub

複製代碼

作者: c_c_lai 時間: 2012-8-22 08:41

回復 24# GBKEE
您誤解我的意思，我的重點僅在於 Rng 變數的使用。

假設：For X = 1 To Rng ~ Next X 之內容非常複雜
1.  如果在 For Next Loop 內 Coding 時一時疏忽，同時引用了 Rng 變數並將其
   值改變；
2.  之後，在 For Next Loop 後段處理時，亦同樣引用了 Rng 變數值，
   此處是希望引用原先的 Rng 變數值時，他忽略了在 For Next Loop 內
   已異動了 Rng 變數值，結果執行發生了不可預期的錯誤。
3.  這種情事常易發生在當模組龐大，處理內容複雜時的不經意處理。

而非您程式的解譯，請您見諒。

作者: GBKEE 時間: 2012-8-22 08:55

回復 25# c_c_lai
看圖解文: 一直不明暸你的真正意思
3. 這種情事常易發生在當模組龐大，處理內容複雜時的不經意處理。
是啊! 所以須要仔細反覆的檢查程式碼 ,執行後的正確性

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