返回列表 上一主題 發帖

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

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

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

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

回復10# freeffly

987


這條件 請還要詳述

TOP

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

TOP

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

TOP

回復 23# c_c_lai
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Integer, i As Integer, x As Integer
  4.     Rng = 10
  5.     i = 0
  6.     For x = 1 To Rng   '這裡迴圈最終值已設定=10 不受以後的影響
  7.         Debug.Print x  '請在即時視窗看 x 的變動
  8.         i = i + 1
  9.         Rng = i + 5    'Rng變數不影響迴圈最終值
  10.         x = Rng        '這 X變數才會影響迴圈的次數
  11.     Next
  12.     MsgBox "迴圈迴結束後 X= " & x
  13. End Sub
複製代碼

TOP

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

TOP

        靜思自在 : 我們最大的敵人不是別人.可能是自己。
返回列表 上一主題