• ベストアンサー
  • 困ってます

以下のマクロは、一応簡単な文字チェックマクロなのですが・・・

L列の5行目から文字の入っている最後の行の範囲で、 L列に『等』という文字が入っているセルで M列に『トウ』の文字が入っていない場合は、MsgBoxを出すというマクロです。 Private Sub 等_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "L").End(xlUp).Row '『i』はD列の5行目から文字の入っている最後の行をいう(行の範囲) If InStr(.Cells(i, "L"), "等") > 0 Then If InStr(.Cells(i, "M"), "トウ") = 0 And .Cells(i, "M") <> "" Then MsgBox i & "行" End If End If Next i End With End Sub これに少し付け加えて、 L列に『等』が2回出てきたら、M列は『トウ』を2回出てこないとMsgBoxを出すようにしたいのですが、どのようにすればよいでしょうか? 例えば L列7行目 柑橘類等や野菜類等 M列7行目 カンキツルイトイヤヤサイルイトウ ※ ひとつ目の『等』のヨミが『トイ』となっていますが、上記のマクロですと ヨミの最後の『トウ』に反応してスルーしてしまいます。 完璧なヨミチェックはマクロでは無理かと思いますが、このくらいはスルーしないマクロを何とかゲットしたいです。。。

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数130
  • ありがとう数9

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.2
  • keirika
  • ベストアンサー率42% (279/658)

Private Sub 等_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.Count, "L").End(xlUp).Row '『i』はD列の5行目から文字の入っている最後の行をいう(行の範囲) If InStr(.Cells(i, "L"), "等") > 0 Then If Len(.Cells(i, "L")) - Len(Application.Substitute(.Cells(i, "L"), "等", "")) <> _ (Len(.Cells(i, "M")) - Len(Application.Substitute(.Cells(i, "M"), "トウ", ""))) / 2 Then MsgBox i & "行" End If End If Next i End With End Sub でどうでしょう。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • 下記のマクロはC列5行目から文字の

    下記のマクロはC列5行目から文字の入っている最後の行までの範囲で セル内に蜜柑や林檎、苺の文字が入っていたら同一行のA列にも蜜、林、苺 の文字を入れるというマクロなのですが・・・ たとえばC列12行目が 『蜜柑林檎苺』 となっていた場合、A列に入る言葉は『苺』となり『蜜』『林』という言葉が 消えてしまいます。 そこでこのマクロを少し改造して、 C列が『蜜柑林檎苺』や『蜜柑苺』となっている場合 A列に入る言葉は『蜜林苺』ないし『蜜苺』という風に積み重ねていくように改造はできないでしょうか? ↓この部分を改造すればできるようになりますか? Cells(i, 2).Offset(0, -1).Value = "蜜" Sub 蜜柑林檎苺() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "蜜柑") > 0 Then MsgBox i & "行目アウト!" Cells(i, 2).Offset(0, -1).Value = "蜜" End If If InStr(.Cells(i, "C"), "林檎") > 0 Then MsgBox i & "行目アウト!" Cells(i, 2).Offset(0, -1).Value = "林" End If If InStr(.Cells(i, "C"), "苺") > 0 Then MsgBox i & "行目アウト!" Cells(i, 2).Offset(0, -1).Value = "苺" End If Next i End With End Sub

  • エクセルのマクロについて

    Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "ア") = 0 Then If InStr(.Cells(i, "D"), "ア(半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub このエクセルマクロはC列に「ア」があって、D列に「ア(半角)」の文字がない場合はメッセージというマクロなのですが、このマクロをア~ンまで同じ作業をしたいのですが、ひとまとめにマクロを組む事はできるのでしょうか?できる場合どのようにすれば良いでしょうか? 下記のようにして見たのですができませんでした。 Sub ア_Click() Dim i As Long With ActiveSheet For i = 5 To .Cells(Rows.count, "C").End(xlUp).Row If InStr(.Cells(i, "C"), "[ア-ン]") = 0 Then If InStr(.Cells(i, "D"), "[ア-ン](半角)") = 0 and .Cells(i,"D")<>"" Then MsgBox i & "行目" Cells(i, 2).Offset(0, -1).Value = "★" End If End If Next i End With End Sub

  • エクセルのマクロについて

    下記は、A列3行の7文字目~10文字と B列5行~文字のある最後の行までの範囲の左から1文字目~4文字 に相違がある場合 MsgBox i & “行目” を出す。 というマクロなのですが、『B列5行~文字のある最後の行までの範囲』の中でも『空白のセルに関してはMsgBox不要』というふうに付加えたいのですがどのようにすればよいでしょうか。 Sub Macro1() Dim i As Long Dim sOrgText As String Dim ltotal As Long With ActiveSheet sOrgText = Mid(.Cells(3, 1), 7, 4) ltotal = .Cells(65536, 2).End(xlUp).Row For i = 5 To ltotal If Not Mid(.Cells(i, 2), 1, 4) = sOrgText Then MsgBox i & "行目" End If Next i End With End Sub

その他の回答 (1)

  • 回答No.1
  • fujillin
  • ベストアンサー率61% (1594/2576)

InStrは検索して何文字目でマッチしたかを返す関数ですから、これを複数回繰り返すという方法もありますが、文字列操作が面倒ですね。 正規表現で検索する方法もありますが、Split関数を利用した以下の方法はいかがでしょうか? カウント用の配列変数を用意しておきます。(ここではarとします) トウの方を調べる例として  ar = Split(.(Cells(i, "M"), Value, "トウ")  としておけば、  UBound(ar) で"トウ"の含まれていた個数を求めることができます。 (ない場合は0、対象セルが空白の時は-1の値になるようです。:エクセル2000)

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • エクセルマクロ 複数特定文字を含む行以外の削除

    M列にある特定の文字が含む行以外のものを削除するマクロを教えて下さい。 現在ネット検索で見つかったマクロを使用しています 【現在使用中のマクロ】 Sub Sample1() Dim i As Long For i = Cells(Rows.Count, "M").End(xlUp).Row To 2 Step -1 If InStr(Cells(i, "M"), "検索したい文字") = 0 Then Rows(i).Delete End If Next i End Sub これだと検索したい文字が1つしか利用できません。 「検索したい文字列1」または「検索したい文字列2」を含まない行を削除したいのですが どのようにマクロを組めばよいのでしょうか? こちらまったくの初心者です。 上記の書式にはこだわりませんので、わかる方教えて下さい。

  • エクセルマクロ 特定の文字列を含む行のみを残す (マクロ修正)

    以下のマクロは、EXCEL2003で 「特定の文字列が含まれている列を削除する」動作をするマクロです Sub Macro1() Const col As String = "A" '文字列が入力されている列 Dim idx As Long Dim keyWord keyWord = Application.InputBox("削除対象の文字列は?", Type:=2) If TypeName(keyWord) <> "Boolean" And Len(keyWord) > 0 Then   For idx = Cells(65536, col).End(xlUp).Row To 1 Step -1     If InStr(Cells(idx, col).Value, keyWord) > 0 Then '    If Application.CountIf(Rows(idx), "*" & keyWord & "*") > 0 Then       Rows(idx).Delete     End If   Next idx End If End Sub このマクロを、 「特定の文字列が含まれている行のみを残し、それ以外を削除する」 というマクロに変更したいと思っています。 是非ご回答お願いいたします。

  • マクロ 値の転記 再度

    マクロ 値の転記 再度 昨日はkyboさんに解答を頂き大変助かりました。 ありがとうございました。 教えて頂いたコードを別のマクロでも活用しよう思ったのですが どのように改変していけばいいのかまた悩んでいます。 度々で申し訳ありませんが、どなたか宜しくお願い致します。 やりたいこと 転記元のBに0以外の数字が入っている場合、転記先のA列に 同じ値を常に5回転記させたい。 "あ"を5回転記→1行あける→"う"を5回転記→(続く・・・) ★Sheet1 転記先(7行目から転記したい)   A ------------------- 7 あ 8 あ 9 あ 10 あ 11 あ -------------------- 12 空行 -------------------- 13 う 14 う 15 う 16 う 17 う -------------------- 18 空行 -------------------- 19 以下 5つの纏まりの枠が300行位まで続く ★Sheet2 転記元(5行目からデータがある)   A    B -------------------- 5 あ 6 あ 7 あ計  100 -------------------- 8 空行 -------------------- 9 い 10 い 11 い 12 い計  0 -------------------- 13 空行 -------------------- 14 う 15 う 16 う 17 う計  500 -------------------- 18 空行 19 (以下、続く) Sub テスト() Dim i As Long '転記元のデータ開始行は5行目 For i = 5 To 300  '転記元のB列が0以外  If Worksheets("転記元").Cells(i, "B") <> 0 Then    Worksheets("転記先").Cells((i - 1) * 5 + 1, "A").Resize(5) _ = Worksheets("転記元").Cells(i, "A")  End If Next i End Sub

  • 繰り返しマクロについて

    先日、マクロについて質問をさせていただきました。 常に右側の列と左側の列のデータを比較して、右側の列のデータが多ければ「↑」マークを、同じなら「―」マークを、少なければ「↓」マークを表示させたいのです。 最初にデータを入れる列はD列7行目から30行目まで。次はE列に同じようににデータ入力した後ににマクロを実行します。これをM列7行目から30行目まで、列に新しいデータを入れるたびに毎回繰り返したいのです。 矢印マークは 常にN列に表示。  で、以下のようなマクロを教えていただきましたが、このマクロだと 比較がされる列が、絶えずD列と、新しく入力した列になってしまいます。 先ほども書きましたが、比較する列は、D列とE列 それが終わったらE列とF列 次はF列とG列 というように常に右側とその直ぐ左側の列の比較をしたいのです。 もう一度 お教えいただきたいのですが、よろしくお願いいたします。 回答いただいたマクロを下に入れておきます。 Sub test() Dim i, j, k As Long Dim vl1, vl2 As Variant For i = 4 To 30 If WorksheetFunction.Count(Range(Cells(i, 4), Cells(i, 13))) > 1 Then j = 4 Do Until Cells(i, j) <> "" j = j + 1 Loop vl1 = Cells(i, j) For k = 4 To 13 If Cells(i, k) <> "" Then vl2 = Cells(i, k) End If Next k If vl1 > vl2 Then Cells(i, 14) = "↓" ElseIf vl1 = vl2 Then Cells(i, 14) = "→" Else Cells(i, 14) = "↑" End If Else Cells(i, 14) = "" End If Next i End Sub

  • 標準モジュールマクロ動作について

    office2010 excelのマクロにて、標準モジュールにて一括の場合と、分割されている場合で動作結果が変わります。 その原因が分からないので教えて頂きたく。 A2セルからR6セルまで、文字列データが入っています。 D列、F列のみ、不特定行が空欄ありです。 D列を検索し、○があったら、行ごと削除します。 C列の最終セルから2行上、1列右のセルを参照し、空欄だったら、A空欄あり のメッセージ表示 E列の最終セルから2行上、1列右のセルを参照し、空欄だったら、B空欄あり のメッセージ表示 マクロ実行前のデータで D2セルが○、D3セルが○、 D4セルが空欄 F4セルが何かしらの文字列あり でマクロを実行させると、 D2セルは空欄、 D4セルが何かしらの文字列あり になります。 メッセージは、A空欄あり のみとなるはずなのですが、 (1)の場合、A空欄あり、B空欄あり と誤りになります。 (2)だとA空欄ありのみ表示されます。 何がおかしいのでしょうか? なお、(1)を2回マクロ実行させると、2回目は、A空欄ありのみ表示です (1)標準モジュール一括の場合 Sub SAKUJO() 'D列で○の非稼働日行を削除 Dim lastRow, r As Long Dim v As Variant 'C列最終行の取得 lastRow = Cells(Rows.Count, 3).End(xlUp).Row 'D列を検索し、非稼働日(○)は行で削除 For Each v In Array("○") For r = lastRow To 2 Step -1 'POINT!最終行から2行目へ If InStr(Cells(r, 4).Value, v) <> 0 Then '指定セルの値が配列内のワードを含むかどうか Rows(r).Delete '含む場合は行を削除 End If Next r Next v '非稼働日を除き、今日から2日前が空欄だったら、メッセージ表示 If Cells(lastRow, 3).Offset(-2, 1) = "" Then MsgBox "A空欄あり" Else End If If Cells(lastRow, 5).Offset(-2, 1) = "" Then MsgBox "B空欄あり" Else End If End Sub (2)標準モジュール分割の場合 Sub SAKUJO() 'D列で○の非稼働日行を削除 Dim lastRow, r As Long Dim v As Variant 'C列最終行の取得 lastRow = Cells(Rows.Count, 3).End(xlUp).Row 'D列を検索し、非稼働日(○)は行で削除 For Each v In Array("○") For r = lastRow To 2 Step -1 'POINT!最終行から2行目へ If InStr(Cells(r, 4).Value, v) <> 0 Then '指定セルの値が配列内のワードを含むかどうか Rows(r).Delete '含む場合は行を削除 End If Next r Next v test End Sub Sub test() '非稼働日を除き、今日から2日前が空欄だったら、メッセージ表示 Dim lastRow ' C列の最終行取得   lastRow = Cells(Rows.Count, 3).End(xlUp).Row If Cells(lastRow, 3).Offset(-2, 1) = "" Then MsgBox "A空欄あり" Else End If If Cells(lastRow, 5).Offset(-2, 1) = "" Then MsgBox "B空欄あり" Else End If End Sub

  • 行ごとに判定するマクロについて教えて下さい

    行ごとに判定するマクロについて教えて下さい。 下記のようなマクロで、添付ファイルのように、行ごとで E列からN列で違った数値がないか、入力されていないセルがないかを調べ 4つすべてのセルが同じ数値でない場合は塗りつぶしはされず O列にOKを表示しないようなマクロを組みたいのですが 現在のマクロだと、行ごとではなく、E3&#65374;N102セルまでの中で 同じ数値がないかを判断してしまっているため K11セルやK15セルのように数値が入力されていないにも関わらずO列の部分にOKが出てしまいます。 他の行に同じ数値が入っているのは関係なしにして 11行目なら11行目だけで 15行目なら15行目だけで、というように行ごに判定していくには どのようにすればいいでしょうか? Sub 判定マクロ回転() Dim i As Integer, j As Integer Range(Cells(3, 15), Cells(102, 15)).ClearContents For i = 3 To 102 For j = 5 To 14 Cells(i, j).Interior.ColorIndex = 0 If WorksheetFunction.CountIf(Range("E3:N102"), Cells(i, j)) > 3 Then If Cells(i, j).Row Mod 2 = 1 Then Cells(i, j).Interior.ColorIndex = 6 Cells(i, 15) = "OK" Else If Cells(i, j).Row Mod 2 = 0 Then Cells(i, j).Interior.ColorIndex = 40 Cells(i, 15) = "OK" End If End If End If Next j Next i If WorksheetFunction.CountIf(Range("O3:O102"), "OK") > 99 Then MsgBox "データチェックOK(^O^)b" End If End Sub

  • 文字変換マクロについて

    数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。 (並びは…数値 スペース 文字列)どなたか教えてください。 よろしくお願いします。 Sub 文字() Dim i As Long For i = 1 To Range("A1").End(xlDown).Row Cells(i, "C") = Cells(i, "A") With Cells(i, "C") .NumberFormatLocal = "@" .Value = StrConv(Cells(i, "C").Value, vbNarrow) .Value = Format(Cells(i, "C").Value, "'00") End With Next i End Sub

  • エクセル マクロ 複数セルの色付けについて

    マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1 、問2_2 、問2_10 (全部で問は2_28まであります)等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか? どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub

  • このような行の集計(統一)方法はありますか?。

      次のような行の集計(統一)をしたいのですが、できる方法があればご教示ください。   統一は方法は、関数でも、マクロでもかまいません。   予めA列でソートを行っており、行は5行目からとなります。      ソートの結果、下記のような   5行目6行目7行目のあA列が同じであるため、5行目と6行目7行目の数字は合計、   文字はそのまま表示とした統一方式です。   なお、BCD列の文字列には必ず1列にしか文字は入りせん。   また、結果を別シートに統一でもかまいません。     列    A  B  C  D  E  F  G             5行目  あ い          1  3  4 6行目  あ    か     3  5  6 7行目  あ       き  1  2  1  ↓ 結果   あ い か き  5  10  11     行は;5行目から500行ほどあり、A列の同一項目行が2行であったり、4行であったり、   また、単一の行もあるなど、バラバラです。   要は、A列が同じ行は一行に統一したいのです。   どなたか、よろしくお願いします。   

  • A列文字とE列文字を比較してG列に判定を出力する

    エクセルマクロ初心者です。 A列に入力されている文字とE列に入力されている文字を比較して、G列に判定を出力(一致:K 不一致:F)するマクロを考えています。 StrComp関数が返す戻り値を利用して StrComp(Cells(j, 1), Cells(j, 5), vbTextCompare) というのを使って比較しようとしましたが、これだと同じ行を参照してしまいます。 A列の方が入力されている行が少ない(例えば:A列は1から10行、E列は1から1000行)ので、A列を基準にE列を比較し、A列が空白行に移った段階で処理を止めたいと思います。 以下に途中まで考えたものを載せます。 j = 1 For j = 1 To Cells(Rows.Count, "E").End(xlUp).Row Cells(j, 10) = StrComp(Cells(j, 1), Cells(j, 5), vbTextCompare)    If Cells(j, 10).Value = 0 Then    Cells(j, 7).Value = "K"    Else    Cells(j, 7).Value = "F"    End If Next j ご教示の程、お願いします。