(已解決)統計顏色次數 - Excel程式區

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

12^#

發表於 2011-5-30 12:24 | 只看該作者

回復 11# GBKEE

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

統計顏色.rar (6.6 KB)

字典兩各字還真難理解

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

13^#

發表於 2011-5-31 19:46 | 只看該作者

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

字典兩各字還真難理解

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

14^#

發表於 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

複製代碼

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

15^#

發表於 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

複製代碼

統計顏色.rar (10.83 KB)

字典兩各字還真難理解

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 277
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

16^#

發表於 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

複製代碼

學海無涯_不恥下問

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

17^#

發表於 2011-6-4 07:26 | 只看該作者

回復 16# Hsieh

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

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

字典兩各字還真難理解

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 277
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-12-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

18^#

發表於 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

學海無涯_不恥下問