- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
14#
發表於 2015-11-18 11:40
| 只看該作者
試試看:- Sub 開始統計()
- Dim Cel As Range, Rng As Range
- Dim FstAddr As String, ndx As Integer, cNum As Integer
- Set Rng = Range("B" & [B21] & ":X" & [C21] & "")
- cNum = 0
- For Each Cel In [G20:L20]
- cNum = Cel.Offset(-1, 0).Interior.ColorIndex
- Cel.Interior.ColorIndex = cNum
- ndx = 0
- On Error GoTo next1
- Rng.Find(What:=Cel, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
- FstAddr = ActiveCell.Address
- Cel.Interior.ColorIndex = cNum
- ActiveCell.Interior.ColorIndex = cNum
- Do
- ndx = ndx + 1
- On Error GoTo next1
- Rng.FindNext(After:=ActiveCell).Activate
- ActiveCell.Interior.ColorIndex = cNum
- Loop Until FstAddr = ActiveCell.Address
- next1:
- Cel.Offset(1, 0) = ndx
- Next
- End Sub
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Rng As Range
- Set Rng = Application.Union([B21:C21], [G20:L20])
- If Intersect(Target, Rng) Is Nothing Then Exit Sub
- If Not Intersect(Target, [B21:C21]) Is Nothing Then
- [B2:X18].Interior.ColorIndex = xlNone
- [G20:L20].Interior.ColorIndex = xlNone
- [G21:L21] = ""
- If [B21] > [C21] Then
- MsgBox "注意:" & Chr(10) & "啟始列的值 不可以大於 終止列的值", vbCritical
- Exit Sub
- End If
- End If
- If Not Intersect(Target, [G20:L20]) Is Nothing Then
- [B2:X18].Interior.ColorIndex = xlNone
- [G20:L20].Interior.ColorIndex = xlNone
- [G21:L21] = ""
- [N21] = "= COUNTA(G20:L20)"
- If [N21] <> 6 Then Exit Sub
- [N20] = "=SUMPRODUCT((G20:L20<>"""")/COUNTIF(G20:L20,G20:L20&""""))"
- If [N20] < 6 Then
- MsgBox "注意:" & Chr(10) & "輸入區資料重覆!!", vbCritical
- Exit Sub
- End If
- End If
- 開始統計
- End Sub
|
|
發表於 2015-11-13 21:17
| 
