Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11551 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【15516】指定した文字列を検索して結果を表示した... Ark 04/6/28(月) 9:52 質問[未読]
【15518】Re:指定した文字列を検索して結果を表示し... IROC 04/6/28(月) 10:21 回答[未読]
【15519】Re:指定した文字列を検索して結果を表示し... ちゃっぴ 04/6/28(月) 10:21 発言[未読]
【15523】Re:指定した文字列を検索して結果を表示し... Ark 04/6/28(月) 11:41 お礼[未読]
【15524】Re:指定した文字列を検索して結果を表示し... IROC 04/6/28(月) 12:34 回答[未読]
【15525】Re:指定した文字列を検索して結果を表示し... Ark 04/6/28(月) 14:52 質問[未読]
【15531】Re:指定した文字列を検索して結果を表示し... kein 04/6/28(月) 16:30 回答[未読]
【15532】Re:指定した文字列を検索して結果を表示し... kein 04/6/28(月) 16:38 回答[未読]
【15529】Re:指定した文字列を検索して結果を表示し... Ark 04/6/28(月) 15:37 お礼[未読]
【15516】指定した文字列を検索して結果を表示した...
質問  Ark  - 04/6/28(月) 9:52 -
引用なし
パスワード
   指定された列（例えばC列）に
「半角のスペース、中黒、ダブルクォーテーション、シングルクォーテーション」が
存在した場合、それぞれの件数をカウントし
メッセージボックスに表示させると同時に該当セルの色を変える…というような
マクロを作成しようと思っています。（セルの色は1種類でOKです）

順序だてて一つずつチャレンジしてみましたが
検索で1日費やし、挫折してしまいました。
皆様のお力をお借りしたく、お願い致します。
マクロ初心者にはこのハードル、高すぎました。。
【15518】Re:指定した文字列を検索して結果を表示...
回答  IROC  - 04/6/28(月) 10:21 -
引用なし
パスワード
   何行くらいのデータが対象でしょうか？

件数が少ないなら、検索しないで、
ループ処理した方が簡単だと思います。
【15519】Re:指定した文字列を検索して結果を表示...
発言  ちゃっぴ  - 04/6/28(月) 10:21 -
引用なし
パスワード
   高度なことを考えずに簡単にやる方法で考えて見てはいかがでしょう。

>指定された列（例えばC列）に

とのことですので、C列を総ループすればいいはずです。
なので、For 〜 Next ステートメントかFor Each 〜 Next ステートメントが
使えると思います。

>「半角のスペース、中黒、ダブルクォーテーション、シングルクォーテーション」が
>存在した場合、それぞれの件数をカウントし

とのことなので、If文とLike演算子を使用すると楽に出来ると思います。

例) 半角のスペースが存在する場合
If セル.Value Like "* *" Then

カウントは変数をインクリメント(i = i + 1)することで簡単に出来ると
思います。

>メッセージボックスに表示させると同時に該当セルの色を変える…というような
>マクロを作成しようと思っています。（セルの色は1種類でOKです）

塗りつぶしは、マクロ記録を利用すれば容易にコードが取れると
思います。

後は、形にするだけですので、ぜひ再度チャレンジしてみてください。
【15523】Re:指定した文字列を検索して結果を表示...
お礼  Ark  - 04/6/28(月) 11:41 -
引用なし
パスワード
   IROCさん、ちゃっぴさん。早速のご回答ありがとうございました。
頂いたヒントを元に何とか動かせるプログラムを作成したいと思います。
もし完成したら見ていただく、という事も可能でしょうか？
【15524】Re:指定した文字列を検索して結果を表示...
回答  IROC  - 04/6/28(月) 12:34 -
引用なし
パスワード
   >もし完成したら見ていただく、という事も可能でしょうか？

完成するのを、お待ちしております。

行き詰まったら、引き続きご質問してください。
【15525】Re:指定した文字列を検索して結果を表示...
質問  Ark  - 04/6/28(月) 14:52 -
引用なし
パスワード
   職場の先輩にヒントを貰い、なんとかそれっぽい形が出来ましたが
指定した全ての文字列をうまくカウントしてくれませんでした。

Const syori As String = "syori"　　　　　　　　　　 'syoriシートの定義づけ
Dim R1 As Integer, C1 As Integer, i As Integer　　　'R1,C1,iの定義づけ
Sub wk9()

'(1)マクロ実行中に画面が動かないようにするおまじない
Application.ScreenUpdating = False

'(2)選択中のブックでシートを選択し、最終行列数を取得する
Sheets(syori).Select
Range("A1").Select
With Sheets(syori).Cells(1, 1).CurrentRegion
　　R1 = .Rows.Count
　　C1 = .Columns.Count

　　Mypos = 0
　　ER_COUNT = 0
　 For i = 2 To C1
　　　 SerchString = .Cells(i, 3).Value
　　　
　　　 Application.StatusBar = SerchString & "..."
　　　
　　　 Mypos1 = InStr(SerchString, " ")　　　　　　 'スペースを探す
　　　 Mypos2 = InStr(SerchString, "・")　　　　　　 '中黒を探す
　　　 Mypos3 = InStr(SerchString, """")　　　　　　 '「”」を探す
　　　 Mypos4 = InStr(SerchString, "'")　　　　　　 '「’」を探す
　　　 Mypos = Mypos1 + Mypos2 + Mypos3 + Mypos4　　'検知した禁則文字を全て足し算
　　　 If Mypos <> 0 Then　　　　　　　　　　　　　　'##0以外だったら（検出されたら）エラー
　　　　　ER_COUNT = ER_COUNT + 1
　　　　　
　　　　　Cells(i, 3).Interior.ColorIndex = 6
　　　 End If
　 Next

End With

MsgBox ER_COUNT & "件"

End Sub

宜しければ見ていただけませんでしょうか？
【15529】Re:指定した文字列を検索して結果を表示...
お礼  Ark  - 04/6/28(月) 15:37 -
引用なし
パスワード
   物凄く単純な凡ミスをしていました。
For i = 2 To C1ではなく、For i = 2 To R1でした。

騒ぐだけ騒いで自己完結してしまいました。申し訳ないです。
皆様に頂いたヒントを今後も活用させて頂きたいと思います。
本当にありがとうございました。

願わくばこの質問が今後似たようなプログラムを
作成する人達の参考になれば、と思います。
【15531】Re:指定した文字列を検索して結果を表示...
回答  kein  - 04/6/28(月) 16:30 -
引用なし
パスワード
   InStr関数で取得できるのは、最初に見つかった位置だけです。だから複数の検索値
が含まれていると、初めに検索スタート位置を 1 にして 0 を返すかどうかチェックし
>0 ならカウンタ変数に +1 する。次に、見つかった位置 +1 をスタート位置にして
再度 InStr関数で調べる・・という処理を、0 が返るかスタート位置が検索対象文字列の
長さになるまで繰り返し行わないと、正しくカウントできません。これを検索文字の
種類の数だけ一つのセルについて調査し、それが終わってやっと次のセルへ移動・・。
という面倒なことをするしかなくなります。そこでこのような調査をする場合は、
正規表現を使うと簡素化できるわけです。以下のサンプルを試してみて下さい。
C列に文字列を入力したセルがないと、何も表示されずに終了します。

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
　　　　 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
　　　End If
　 Next
　 MsgBox "半角スペース = " & Ct1 & vbLf & _
　 "中黒 = " & Ct2 & vbLf & "ダブルクォーテーション = " & _
　 Ct3 & vbLf & "シングルクォーテーション = " & Ct4, , _
　 "検索文字の個数": Exit Sub
ErLine:
　 Set ObjRE = Nothing
End Sub
【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 した方が良いでしょう。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11551 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free