|
なんか解決しちゃったようですが、セル1個ずつについてカウントし、色を着ける
のなら
Sub MyCount_St()
Dim C As Range
Dim Sta As String, CkSt As String
Dim Ct1 As Long, Ct2 As Long, Ct3 As Long, Ct4 As Long
Dim ObjRE As Object, Match As Object, Matches As Object
Sta = "・"
Set ObjRE = CreateObject("VBScript.RegExp")
With ObjRE
.Pattern = "[\40\42\47" & Sta & "]"
.Global = True
End With
On Error GoTo ErLine
For Each C In Range("C:C").SpecialCells(2, 2)
CkSt = C.Value
If ObjRE.Test(CkSt) Then
Ct1 = 0: Ct2 = 0: Ct3 = 0: Ct4 = 0
Set Matches = ObjRE.Execute(CkSt)
For Each Match In Matches
Select Case Match.Value
Case " "
Ct1 = Ct1 + 1
Case "・"
Ct2 = Ct2 + 1
Case """"
Ct3 = Ct3 + 1
Case "'"
Ct4 = Ct4 + 1
End Select
Next
Set Matches = Nothing
C.Interior.ColorIndex = 6
MsgBox "半角スペース = " & Ct1 & vbLf & _
"中黒 = " & Ct2 & vbLf & "ダブルクォーテーション = " & _
Ct3 & vbLf & "シングルクォーテーション = " & Ct4, , _
"検索文字の個数"
End If
Next
ErLine:
Set ObjRE = Nothing
End Sub
というようなコードになります。チェックするセルが多いと時間がかかりますから
MsgBox を止めて C.Address と共に Debug.Print した方が良いでしょう。
|
|