Q&A
「プロシージャの呼び出し、または引数が不正です。」というエラーが出るのは、どんな値を使った場合ですか❓
Cells(i, 9)とか、Cells(j, 5)とかでは、どんな文字列なのか判りませんし、MaxLen, MaxLen2にどのような値が入るのかも想像できないので、具体的にどのような操作が起こるのかが判りません。
VBA初心者です。
お手柔らかにお願いします。
さて、次のようなコードを書きました。
Sub 文字列検索() Application.ScreenUpdating = False Dim MaxRow As Byte, MaxRow2 As Byte, i As Byte, length As Byte, j As Byte, MaxLen As Integer, k As Integer, rng As String, start As Integer MaxRow = Range("A1").End(xlDown).Row If Range("I2").End(xlDown).Row > 200 Then MsgBox "検索文字が入力されていません。" Exit Sub End If MaxRow2 = Range("I2").End(xlDown).Row For i = 2 To MaxRow2 length = Len(Cells(i, 9)) Cells(i, 9).Select For j = 2 To MaxRow MaxLen = Len(Cells(j, 5)) For k = 1 To MaxLen rng = StrConv(Cells(i, 9).Value, vbWide) If InStr(k, Cells(j, 5), rng) > 0 Then start = InStr(k, Cells(j, 5), Cells(i, 9)) Cells(j, 5).Characters(start:=start, length:=length).Font.Size = 16 Cells(j, 5).Characters(start:=start, length:=length).Font.ColorIndex = 3 k = start Else k = MaxLen End If rng = StrConv(Cells(i, 9).Value, vbNarrow) If InStr(k, Cells(j, 5), rng) > 0 Then start = InStr(k, Cells(j, 5), Cells(i, 9)) Cells(j, 5).Characters(start:=start, length:=length).Font.Size = 16 Cells(j, 5).Characters(start:=start, length:=length).Font.ColorIndex = 3 k = start Else k = MaxLen End If Next k Next j Next i End Sub
この記述で検索文字を半角にして実行すると18行目がスルーされ、同じ構文の27行目の"If InStr(k, Cells(j, 5), rng) > 0 Then"の部分で「プロシージャの呼び出し、または引数が不正です。」と表示されてエラーになり、その下の行の変数startが0になってしまいます。
また、全角文字で検索すると、対象文の中の同じ全角文字は検索できますが、半角で入力されたものはスルーされてしまいます。
理由がわからないので教えていただけないでしょうか？
なお、このマクロの目的は検索対象の文章の中に、検索したい文字が全角であったり半角で入力されたりしているため、マクロで検索したい文字を全角と半角に置き換えてそれぞれを検索し、見つかった場合はフォントサイズを大きくして色を変えたい、というものです。
また、検索対象の文章の中に検索文字が複数ある場合があるため、1度見つけても次の位置から最後の文字まで再度検索させています。
わかりにくければ補足させていただきます。
よろしくお願いします。
【画像についての説明】
E列が検索対象となる文章が入力されている列、I列が検索文字を入力する列です。
文章は適当に貼りつけたものなので、内容は気にしないでください。
検索文字の「英語」ではE2のセルで見つけますが、「男」ではE2とE6のセルで見つけます。
また、「マゾ」ではE7のセルの”マゾ"と"ﾏｿﾞ"の両方を検索できるようにしたいです。
不明な点があれば答えさせていただきます。
よろしくお願いいたします。
この検索を行うにあたって、前提となるレイアウトがあるはずですが、そのレイアウトの画像を提示していただけませんでしょうか。どのセルに検索文字が設定されるのか、どのセルを検索しているのかなどの仕様も文章で提示してください。
すみません。
まちがって自己解決の方に返答してしまいました。
以下、転載します。
回答ありがとうございます。
たとえば、「本日クレームがあった。きちんとｸﾚｰﾑ処理をした」という検索対象文があったとして、これがCells(j, 5)で、この文章の文字数がMaxLenです。
この文章の中から「クレーム」を検索するとして、これがCells(i, 9)です。
検索文字として入力する「クレーム」でクレームとｸﾚｰﾑの両方を引っかけたいので、vbWideとvbNarrowとで処理をさせています。
MaxLen2はないと思うのですが、見落としていたらすみません。
MaxRow2のことでしたら、それは検索文字を入力するI列の最終行の数値になります。
検索文字は複数あります。
まだ不明な点がありましたら、補足させていただきます。
よろしくお願いいたします。
レイアウトの画像については、明日掲載させていただきます。
申し訳ありません。
画像を添付しました。
よろしくお願いいたします。
カタカナとひらがなは区別しますか。
Ｅ列に ”やまぐちけん”
Ｉ列に "ﾔﾏｸﾞﾁ"
の文字があると、”やまぐち” が赤くなることを望んでますか？
はい。カタカナとひらがなは区別したいです。
コード部分はマークダウン書式にしてください。
コード部分を選択して、ツールバーの「<code>」ボタンをクリックします。
変更しました。
申し訳ありませんでした。
回答5件
0
ベストアンサー
簡単な確認しかしていませんが、これでいかがでしょうか。
動作上の不具合などがあれば（実行時間が長いのも含む）返信ください。
実行時間改善の余地は少ないです。
vba
1Option Explicit 2 3Type USRSTR 4 OrgStr As String '元の文字列 5 ZenStr As String '全角文字列 6 HanStr As String '半角文字列 7 ZenLen As Long '全角文字列の文字数 8 HanLen As Long '半角文字列の文字数 9End Type 10 11Public Sub 文字列検索() 12 Application.ScreenUpdating = False 13 Dim maxrow As Long 'E列最大行 14 Dim maxrow2 As Long 'I列最大行 15 Dim ustrs() As USRSTR '検索文字の配列 16 Dim ucnt As Long '検索文字の数 17 Dim wrow As Long 18 maxrow = Cells(Rows.Count, "E").End(xlUp).Row 19 maxrow2 = Cells(Rows.Count, "I").End(xlUp).Row 20 If maxrow2 < 2 Then 21 MsgBox "検索文字が入力されていません。" 22 Exit Sub 23 End If 24 Dim stime As Variant 25 Dim etime As Variant 26 stime = Time 27 28 '検索文字列を配列へ格納する 29 ucnt = 0 30 For wrow = 2 To maxrow2 31 If Cells(wrow, "I").Value <> "" Then 32 ReDim Preserve ustrs(ucnt) 33 ustrs(ucnt).OrgStr = Cells(wrow, "I").Value 34 ustrs(ucnt).ZenStr = StrConv(ustrs(ucnt).OrgStr, vbWide) 35 ustrs(ucnt).HanStr = StrConv(ustrs(ucnt).OrgStr, vbNarrow) 36 ustrs(ucnt).ZenLen = Len(ustrs(ucnt).ZenStr) 37 ustrs(ucnt).HanLen = Len(ustrs(ucnt).HanStr) 38 ucnt = ucnt + 1 39 End If 40 Next 41 '検索対象文字列（Ｅ列）について全行繰り返し 42 For wrow = 2 To maxrow 43 If Cells(wrow, "E").Value <> "" Then 44 'E列１行の処理 45 Call one_line(Cells(wrow, "E"), ustrs) 46 End If 47 Next 48 etime = Time 49 MsgBox ("完了 実行時間(秒)=" & Second(etime - stime)) 50End Sub 51'１行の処理 52Private Sub one_line(ByRef rg As Range, ByRef ustrs() As USRSTR) 53 Dim i As Long 54 Dim trg_ZenStr As String 55 Dim trg_ZenLen As Long 56 Dim pos As Variant 57 Dim ustr As USRSTR 58 trg_ZenStr = StrConv(rg.Value, vbWide) 59 trg_ZenLen = Len(trg_ZenStr) 60 '全ての検索文字列を処理する 61 For i = 0 To UBound(ustrs) 62 ustr = ustrs(i) 63 '1文字列の処理 64 Call one_string(rg, ustr, trg_ZenStr, trg_ZenLen) 65 Next 66End Sub 67'1文字列の処理 68Private Sub one_string(ByRef rg As Range, ByRef ustr As USRSTR, ByRef trg_ZenStr As String, ByVal trg_ZenLen As Long) 69 Dim i As Long, j As Long 70 Dim update_len As Long 71 Dim pos As Variant 72 j = 1 73 For i = 1 To trg_ZenLen 74 pos = InStr(i, trg_ZenStr, ustr.ZenStr, vbBinaryCompare) 75 If pos = 0 Then Exit Sub 76 pos = InStr(j, rg.Value, ustr.OrgStr, vbTextCompare) 77 If pos = 0 Then Exit Sub 78 Call get_update_len(pos, rg, ustr, update_len) 79 If update_len <> 0 Then 80 rg.Characters(start:=pos, length:=update_len).Font.Size = 16 81 rg.Characters(start:=pos, length:=update_len).Font.ColorIndex = 3 82 End If 83 j = pos + update_len 84 Next 85End Sub 86'1文字列の更新サイズ取得 87Private Sub get_update_len(ByVal start_pos As Variant, ByRef rg As Range, ByRef ustr As USRSTR, ByRef update_len As Long) 88 Dim i As Long, j As Long 89 Dim str As String 90 Dim pos As Variant 91 If ustr.ZenLen = ustr.HanLen Then 92 update_len = ustr.ZenLen 93 Exit Sub 94 End If 95 For i = ustr.ZenLen To ustr.HanLen 96 str = Mid(rg.Value, start_pos, i) 97 pos = InStr(1, str, ustr.OrgStr, vbTextCompare) 98 If pos <> 0 Then 99 update_len = i 100 Exit Sub 101 End If 102 Next 103 update_len = 0 104End Sub 105
投稿2019/09/13 10:51
編集2019/09/14 00:08総合スコア5493
0
ほぼ、仕様が確定かと思いますので、以下の方針で作成してみます。
問題点があれば、その旨、返信ください。
１．maxrow,maxrow2の取得方法
質問者が提示しているmaxrow,maxrow2の取得方法は、正しくないので、
正しい方法で、maxrow,maxrow2を取得する。
尚、maxrowはＡ列の最大行を取得しているが、Ｅ列の最大行を取得するように変更する。
２．Ｅ列の空白セルの扱い
Ｅ列のセルには、空白のセルも含まれている場合を考慮する。（画像では見えないが念のため）
空白のセルはスキップする。
３．Ｉ列の空白セルの扱い
Ｉ列のセルには、空白のセルも含まれている場合を考慮する。（画像でそのように見える）
空白のセルはスキップする。
４．検索アルゴリズム
全角、半角を区別せずに検索する方法として、Ｉ列を全角に変換した文字列、及び半角に変換した文字列で、２回検索を行っているが、この方法は採用しない。例えば、以下のようなケースの場合、期待した結果にならない。
Ｅ列＝ﾔﾏダ （先頭の2文字が半角、最後の１文字が全角）
Ｉ列＝ﾔﾏﾀﾞ
Ｉ列は、全て半角の「ﾔﾏﾀﾞ」 もしくは 全て全角の「ヤマダ」 なのでマッチしない。
これを解決するために、vbTextCompareで比較を行うことが考えられるが、ひらがなとカタカナを区別しないので比較してしまうという問題が残る。
よって、以下の方法を採用する。
(1)Ｅ列を全角にした文字列、Ｉ列を全角にした文字列で比較する。（vbBinaryCompareモード）
(2)上記でマッチしたとき、さらに、Ｅ列はそのままの文字列、Ｉ列もそのままの文字列で比較する。（vbTextCompareモード）
(3)上記の（２）でマッチしたとき、検索文字列があると判定する。
５．濁音や半濁音を含むケースで、変更される文字数が期待した結果にならない件の解決方法
検索文字があると判定されたとき、更新する文字数（赤く染める文字数）を以下の手順で決定する。
(1)Ｉ列の文字列を全て全角にした時の文字数と全て半角にした時の文字数が、同じなら、その文字数を更新文字数とする。
(2)異なる場合は、Ｅ列の検索で得られた開始位置から、「Ｉ列の文字列を全て全角にした時の文字数」＋１~~~~文字を切り出して、その文字列で検索を行う。マッチしない場合は、これを、Ｉ列の文字を全て半角にした時の文字数になるまで行う。
マッチしたときの切り出した文字数が更新文字数となる。
上記の仕様で作成します。問題点、不明点があれば、返信ください。
投稿2019/09/13 10:09
編集2019/09/14 01:45総合スコア5493
tastu99さん
丁寧に回答していただきましてありがとうございます。
1つ教えてください。
4.についてなのですが、たとえば"ABC"（半角）で検索しようとして対象文に"ＡＢＣ"（全角）という言葉があった場合、（1）では条件に当てはまりますが、（2）では弾かれてしまうのでしょうか？
よろしくお願いいたします。
はじかれません。マッチします。
通常、（１）でマッチなら（２）でも必ずマッチするはずです。あえて（２）でマッチを行うのは、
その文字列（全角に変換しない文字列）の開始位置を取得するためです。
これを（２）でマッチ、（１）でマッチの順序で行うと、（１）ではじかれる可能性があります。（ひらがなとカタカナのマッチの場合）
0
ポイントは InStr関数は、
InStr(検索開始位置, 検索対象文字列, 検索語, 比較モード)
というフォーマットで、比較モード引数に vbTextCompare を指定すると全角/半角を区別しないということです。また、比較モード引数を省略すると vbTextCompare を指定したことになります。
つまり、vbTextCompareを指定すれば全角と半角をわけて検索する必要はないということです。
あと、検索対象と検索語が複数あるなら、
検索処理は関数に分割して、複数検索のループ内で関数をCallするようにすると可読性があがり、メンテナンス性もよくなります。
検索して合致したらフォント色を赤にするプロシージャ
vba
1Public Sub FindWord(TargetRang As Range, searchWordRange As Range) 2 Dim TargetWords As String 3 TargetWords = TargetRang.Value 4 5 Dim searchWord As String 6 searchWord = searchWordRange.Value 7 8 Dim Pos As Integer 9 Pos = 1 10 Do 11 Pos = InStr(Pos, TargetWords, searchWord, vbTextCompare) 12 If Pos = 0 Then Exit Do 13 myRng.Characters(start:=i, length:=Len(myWOrd)).Font.ColorIndex = 3 14 Pos = Pos + Len(myWOrd) - 1 15 Loop 16End Sub
ループでの呼び出し例
vba
1'前略 2 3 For i = 2 To MaxRow2 4 For j = 2 To MaxRow 5 Call FindWord(Cells(j, 5), Cells(i, 9)) 6 Next j 7 Next i
投稿2019/09/13 01:59
総合スコア34064
回答していただきましてありがとうございました。
フォント職を変更するプロシージャをそのまま貼り付けて実行しようとしましたが動きませんでした。
そこで、
Public Sub FindWord(TargetRang As Range, searchWordRange As Range)
を
Public Sub FindWord()
Dim TargetRang As Range, searchWordRange As Range
に書き換えて実行するとTagetWordsのオブジェクト変数が設定されていない、というエラーメッセージが出ました。
TargetRangにはどういった値を与えればいいでしょうか？
よろしくお願いいたします。
vbTextCompareを指定すると、ほぼ、理想通りの結果が得られるかと思いますが、
１点、気になるのは、カタカナとひらがなも区別せずに比較してしまう、ということです。
Ｅ列に ”やまぐちけん”
Ｉ列に "ﾔﾏｸﾞﾁ"
の文字があると、”やまぐち” が赤くなりますが、これは望んだ結果なのでしょうか。
質問者の要件は、「全角と半角を区別しない」とかいてあります。
この点、質問者に確認したいところです。
回答ありがとうございます。
カタカナとひらがなの区別はしたいですね。
あと、他にも問題がありまして、例えば「私の名前はヤマグチです」という文章を検索対象として「ヤマグチ」で検索すると、濁音や半濁音は点々と丸がPCでは1文字としてカウントされるので、「ヤマグ」までしかフォントが変更されなくなってしまいます。
逆に「ﾔﾏｸﾞﾁ」で検索すると、「ヤマグチで」まで変更されてしまします。
なので、vbWideとvbNarrowに分けて処理するようにしたのですが、スマートでないことはわかっています。
何かうまく解決する方法はないでしょうか？
よろしくお願いします。
tatsu99さん
カタカナとひらがなは区別するかどうか、半角カナの濁点、半濁点の扱いについては、考慮してませんので、その辺の仕様が、明確になったら、仕様に応じて、修正する必要はありますね。
sishouさん
FindWord は回答のままで、下記で正しく動作するか確認してみてください。
Call FindWord(Cells(2, 5), Cells(2, 9))
sishouさん
カタカナとひらがなは区別する、カタカナの全角/半角は区別しないということですね。
英字の全角/半角、大文字/小文字の区別はどうしますか。
データに半角/全角が混在していると、そのデータを利用するときに(検索、抽出など)複雑になるので、入力時にカタカナは全角のみ許可するか、入力後に全角に変換しておくと、その後の処理がシンプルになります。
「濁音や半濁音を含むケースで、変更される文字数が期待した結果にならない」件については、
かなり難しい問題です。もっとも、簡単なのは、マクロ実行時、Ｅ列の文字を全て全角にしてしまうことです。Ｉ列も全角にし、比較します。そうすれば、実現できますが、Ｅ列の文字を全角にしてしまうのは、まずいでしょうか。（Ｅ列は全角にした結果が表示されます）
ちょっとよくわからないのですが、マクロによってE列を全角に置き換えるということでしょうか？
そうすると英数字の見栄えが悪いかなあ、という懸念が残ります。
「VBA 英数字のみ半角」をキーワードで検索するとサンプルコードが見つかりますので、それを使えば、
カタカナは全角、英数字は半角に統一させることが可能です。
検索語も、カタカナ全角、英数字は半角に変換して、IsStr はバイナリモード(vbBinaryCompare)を指定すればOKです。
>ちょっとよくわからないのですが、マクロによってE列を全角に置き換えるということでしょうか？
はい、その通りです。見栄えが悪くなるので却下ということですので、Ｅ列は全角に変換しない方向で考えてみます。かなり、複雑になりますが、心配なのは、処理時間です。Ｅ列は最大およそ何行ありますか。
Ｉ列は最大、何行ありますか。（空白行は除いてカウント）
E列は約200行、I列は20行程です。
hatena19さん
「VBA 英数字のみ半角」にするサンプルコードを見つけたので実行しようとしたのですが、
Dim re As RegExp
のところで「ユーザー定義型は定義されていません。」というメッセージが出てしまいます。
省略しても進みません。
コードの全文を以下に記します。
Sub han2zenkana()
Dim r As Long, c As Long
Dim re As RegExp
Dim rng As Range
Dim dat, rdat
Dim m, matches
Set re = New RegExp
re.Global = True
re.Pattern = "[Ａ-Ｚａ-ｚ０-９／．，（） ]"
If TypeName(Selection) <> "Range" Then Exit Sub
Set rng = Selection.CurrentRegion
rng.Select
For r = 1 To rng.Rows.Count
For c = 1 To rng.Columns.Count
dat = rng.Cells(r, c).Formula
If InStr(dat, "=") <> 1 And Len(dat) > 0 Then ' 関数でない場合のみ
dat = StrConv(dat, vbWide) ' 一度全て全角に
Set matches = re.Execute(dat)
For Each m In matches
dat = Replace(dat, m.Value, StrConv(m.Value, vbNarrow))
Next m
rng.Cells(r, c) = dat
Debug.Print r & " " & dat
End If
Next c
Next r
End Sub
すみません。
マークダウン書式にする方法がわかりませんでした。
VBAの画面のメニューで[ツール]→[参照設定]をクリックしてダイアログを開き、「Microsoft VBScript Regular Expressions 5.5」にチェックを付けてください
0
セルA1に検索対象文字列、セルA2に検索文字列がある場合
vba
1 Dim myRng As Range 2 Dim myWords, myWord, searchWord As String 3 Dim i, j As Integer 4 5 Set myRng = ActiveSheet.Cells(1, 1) 6 myWords = StrConv(myRng.Value, vbWide) 7 myWord = ActiveSheet.Cells(2, 1).Value 8 9 i = 1 10 j = 0 11 While i <> 0 12 i = InStr(i, myWords, myWord) 13 j = j + i 14 If i <> 0 Then 15 myRng.Characters(Start:=j, Length:=Len(myWord)).Font.ColorIndex = 3 16 myWords = Right(myWords, Len(myWords) - (i + Len(myWord) - 1)) 17 j = j + Len(myWord) - 1 18 End If 19 Wend 20
投稿2019/09/12 11:54
総合スコア10728
0
回答ありがとうございます。
たとえば、「本日クレームがあった。きちんとｸﾚｰﾑ処理をした」という検索対象文があったとして、これがCells(j, 5)で、この文章の文字数がMaxLenです。
この文章の中から「クレーム」を検索するとして、これがCells(i, 9)です。
検索文字として入力する「クレーム」でクレームとｸﾚｰﾑの両方を引っかけたいので、vbWideとvbNarrowとで処理をさせています。
MaxLen2はないと思うのですが、見落としていたらすみません。
MaxRow2のことでしたら、それは検索文字を入力するI列の最終行の数値になります。
検索文字は複数あります。
まだ不明な点がありましたら、補足させていただきます。
よろしくお願いいたします。
投稿2019/09/12 09:14
総合スコア9
あなたの回答
tips
プレビュー
