Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

65846 / 76807

←次へ　｜　前へ→


	【15532】Re:指定した文字列を検索して結果を表示した...

kein - 04/6/28(月) 16:38 -


	引用なし

	パスワード

なんか解決しちゃったようですが、セル１個ずつについてカウントし、色を着ける
のなら

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 した方が良いでしょう。

0 hits

▼

【15516】指定した文字列を検索して結果を表示した... Ark 04/6/28(月) 9:52