返回列表 上一主題 發帖

請教一下!下列的語法可用迴圈來簡化嗎?

回復 2# skyutm
  1. Sub nn()
  2.     Dim I As Integer, ch1 As Integer, ch2 As Integer, ch3 As Integer, ch4 As Integer
  3.     For I = 3 To 43
  4.         Worksheets("期中成績").Range("c" & 5 + I - 3).Value = (Range("c" & I) * ch1 + Range("h" & I) * ch2 + Range("i" & I) * ch3 + Range("j" & I) * ch4) / 100
  5.     Next
  6. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2012-8-24 20:56 編輯

回復 4# skyutm
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng  As String, I As Integer, 分數間格 As Integer, Msg As String
  4.     分數間格 = 10             '也可以間格 5分
  5.     Rng = Worksheets("期中評量").Range("c3", Range("c3").End(xlDown)).Address   '計算範圍的Address
  6.     'Application.Min(Range(Rng)) :最低分-> 還要加1個分數間格 來執行迴圈
  7.     For I = 100 To Application.Min(Range(Rng)) - 分數間格 Step -分數間格 '- : 負數迴圈遞減
  8.         If I = 100 Then
  9.             Msg = "100 = " & Application.Evaluate("SumProduct((" & Rng & ">=100)*1 )")
  10.         Else
  11.             Msg = Msg & Chr(10) & I + 分數間格 - 1 & "~" & I & " = " & Application.Evaluate("SumProduct((" & Rng & "<=" & I + 分數間格 - 1 & ")*(" & Rng & ">=" & I & " ))")
  12.         End If
  13.     Next
  14.     MsgBox Msg
  15. End Sub
複製代碼
補上另一寫法
  1. Option Explicit
  2. Sub Ex_CountIf()
  3.     Dim Rng As Range, 間隔 As Integer, A As Integer, B As Integer, I As Integer, AR(1 To 2)
  4.     Set Rng = Range("A1:A" & [A1].End(xlDown).Row)  '統計的範圍
  5.     間隔 = 10
  6.     For I = 100 To Application.Min(Rng) - 間隔 Step -間隔
  7.         B = Application.CountIf(Rng, ">=" & I)
  8.         'COUNTIF 工作表函數: 計算某範圍內符合某搜尋準則的儲存格個數
  9.         If B - A > 0 Then
  10.             AR(1) = AR(1) & "," & IIf(I < 100, I + 間隔 - 1 & "~", "") & I
  11.             AR(2) = AR(2) & "," & B - A
  12.             A = B
  13.         End If
  14.     Next
  15.     AR(1) = Application.Transpose(Split(Mid(AR(1), 2), ","))
  16.     AR(2) = Application.Transpose(Split(Mid(AR(2), 2), ","))
  17.     [B:C] = ""
  18.     [B1].Resize(UBound(AR(1))) = AR(1)
  19.     [C1].Resize(UBound(AR(2))) = AR(2)
  20. End Sub
複製代碼

TOP

本帖最後由 GBKEE 於 2012-8-25 05:55 編輯

回復 6# 假面超人
  1. 'Case "0" To "69" 應是-> Case "0" To "59"
  2. '但 6,7,8,9,無法計算到, 可是 101 會計算到
  3. '建議修改如下
  4. For I = 1 To myRowCount
  5.     myrange = Sheets("期中評量").Range("c" & I)
  6.     Select Case myrange
  7.         Case 100
  8.             A = A + 1
  9.         Case 90 To 99
  10.             B = B + 1
  11.         Case 80 To 89
  12.             c = c + 1
  13.         Case 70 To 79
  14.             d = d + 1
  15.         Case 60 To 69
  16.             E = E + 1
  17.         Case 0 To 59
  18.             f = f + 1
  19.     End Select
複製代碼

TOP

回復 9# 假面超人
.Value 不知為何會加上的,已更正了

TOP

        靜思自在 : 口說好話、心想好意、身行好事。
返回列表 上一主題