GBKEE

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

回復10# freeffly

9

8

7

這條件 請還要詳述

freeffly

回復 11# GBKEE


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

下載次數: 11

2011-5-30 12:22

freeffly

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

GBKEE

回復 13# freeffly


是這樣嗎?

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

複製代碼

freeffly

回復 14# 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
   
5.         .Interior.ColorIndex = xlNone
   
6.         .Font.ColorIndex = 0
   
7.         .Font.Bold = False
   
8.     End With
   
9.     Set Rng = Range("C5:AD" & [A65536].End(xlUp).Row)
   
10.     For Each R In Rng.Rows
    
11.         Set Rng = R.Cells(1)
    
12.         A = 0
    
13.         Set Rng = R.Cells(1, 0).End(xlToRight)
    
14.         Rng.Interior.ColorIndex = 0
    
15.         Y = [iv4].End(xlToLeft).Column - 1
    
16.         For ii = 2 To 28
    
17.             If R.Cells(1, ii) <> "" And Rng < R.Cells(1, ii) Then
    
18.                 Set Rng = R.Cells(1, ii)
    
19.                 With R.Cells(1, ii).Font
    
20.                     .ColorIndex = 7
    
21.                     .Bold = True
    
22.                 End With
    
23.                 A = A + 1
    
24.                 With R.Cells(1, Y)
    
25.                     .Value = A
    
26.                     .Interior.ColorIndex = 4
    
27.                 End With
    
28.             ElseIf R.Cells(1, ii) <> "" And Rng > R.Cells(1, ii) Then
    
29.                 Set Rng = R.Cells(1, ii)
    
30.             End If
    
31.         Next
    
32.     Next
    
33. End Sub

複製代碼

統計顏色.rar (10.83 KB)

下載次數: 12

2011-6-1 21:59

Hsieh

回復 15# freeffly


    直接判斷數值是否增加

1. Sub ex()
   
2. [AE:AE] = ""
   
3. R = 5
   
4. Do Until Cells(R, 2) = ""
   
5. Set Rng = Range(Cells(R, 3), Cells(R, "AD"))
   
6. i = 1
   
7. Do Until Rng(1, i) <> ""
   
8. i = i + 1
   
9. Loop
   
10. first = Rng(1, i): i = i + 1
    
11. For k = i To Rng.Count
    
12.   If Rng(1, k) > first Then cnt = cnt + 1
    
13.   If Rng(1, k) <> "" Then first = Rng(1, k)
    
14. Next
    
15. Cells(R, "AE") = cnt: cnt = 0
    
16. R = R + 1
    
17. Loop
    
18. End Sub

複製代碼

freeffly

回復 16# Hsieh


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

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

Hsieh

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

回復 18# Hsieh


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

sammyshain

真的好厲害~