id:moon-fondu
ポイントあり1500ptベストアンサーあり
コンピュータ学習・教育

Excelで条件に一致するセルを検索、抽出し、太字にしてセルの色を塗りつぶして、さらに個数をカウントしたい


今、Sheet1にコードがずらりと記載されておりまして、行数にしてA2～A10000まで、1万行ほどあります。

この状況におきまして。

A1からA10000までを"りんご"という文字列で検索しまして。
部分一致したら、そのセル全てを太字にして、更に黄色く塗りつぶします。
そしてその一致したセルが何個あったかというのを累計でカウントしていき…最後にJ1セルに、その個数を書き込みたいです。

そういった処理が効率的に行えると助かります…お力添えいただけますと幸いです。
よろしくお願い致します<m(__)m>

回答の条件
  • 1人10回まで
  • 登録：
  • 終了：2020/02/04 20:58:48
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:huumm No.4

回答回数8ベストアンサー獲得回数2

ポイント500pt 
Sub test()

Dim i As Long, j As Long

j = 0

For i = 1 To Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
'1 To 1000　でも可、データ最終行まで処理にしてます

 If InStr(Cells(i, 1), "りんご") > 0 Then
 
  With Cells(i, 1)
  .Font.Bold = True
  .Interior.ColorIndex = 6
  End With
 j = j + 1
 End If

Next i

Range("J1") = j

End Sub

InStr関数は文字列の中をキーワード検索して、見つかると開始位置を返してくれます。
例）Range("A1")=InStr("わたしのりんご","りんご")　→　A1セル：５
みつからないと０を返すので、返ってくる値が１以上であればキーワードがセル上に存在してるのが分かります。詳しくは、InStr関数で検索してみてください。

id:huumm

1000行のデータでは実行してないので、もし重いようでしたらApplication.ScreenUpdating = Falseとかを追記するといいかも…。
https://tonari-it.com/vba-processing-speed/

2020/01/29 00:24:59
id:moon-fondu

すごいです！早いです！ありがとうございます(^^;)

2020/01/30 22:00:14

その他の回答（3件）

id:AichiKaoru No.1

回答回数180ベストアンサー獲得回数37

ポイント100pt

　
moon黄色りんごファイルを作成しましたのでダウンロードしてください。
https://firestorage.jp/download/a3d1f84ae6a263a3a07eda98377a93b3ed7eb7a4
　
シート１のＢ列、Ｃ列、セルＪ１に　関数式を設定します。
　
シート２にシート１の内容をコピーして、値の貼り付けをしてから、
Ｃ列を基準にして、並べ替えをおこない、
Ｃ列のりんごを含む１塊のセル群を黄色く着色します。
Ｃ列の書式を太字にしておきます。
　
シート３にシート２の内容をコピー貼り付けします。
列Ｂを基準にして、昇順に並べ替えを行ってから、
Ｃ列の内容を、シート１のＡ列にコピー貼り付けをします。
　
以上で　求めるデータを得ることができます。
　
　
　

id:moon-fondu

関数詳しくないと思いつきませんよね、ありがとうございます！

2020/01/30 21:59:42
id:a-kuma3 No.2

回答回数4974ベストアンサー獲得回数2154

ポイント400pt

手作業でやるとしたら、以下のような手順になると思います。

  1. 対象のシートにフィルターを適用する
  2. A列で、テキストフィルターの「指定の値を含む」で "りんご" を指定して絞り込む
  3. 絞り込まれた状態で、A列の 2行目から最後の行までを選択
  4. ステータスバーに「データの個数」が表示されているので、J1 にその数字を書き込む
  5. 選択対象でセルの書式設定で、太字と背景色の黄色を設定する
  6. フィルターを解除する

この手順をマクロにしてみました。
下記のマクロを標準モジュールにはりつけて、処理対象のシートを選択した状態で do_count サブルーチンを実行してください。

Sub mark_line_and_count(keyword)
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.Cells.AutoFilter
    End If
    ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:="=*" & keyword & "*", Operator:=xlAnd
    last_row = Cells(Rows.Count, 1).End(xlUp).Row
    Set filtered_range = Range(Cells(2, 1), Cells(last_row, 1)).SpecialCells(xlCellTypeVisible)
    Range("j1").Value = filtered_range.Count
    filtered_range.Font.Bold = True
    filtered_range.Interior.Color = RGB(255, 255, 0)
    ActiveSheet.Cells.AutoFilter
End Sub

Sub do_count()
    keyword = "りんご"
    Call mark_line_and_count(keyword)
End Sub
他1件のコメントを見る
id:a-kuma3

コメントに書いてもらった条件でも、手元では正しく動いています。
んー、どこが違うんだろう。

2020/01/30 22:21:26
id:moon-fondu

すみません、今日、実行すると「3」となり、黄色い塗りつぶしも、空白行はされなかったです！自分の手違いだったようで…お騒がせしました💦

2020/02/04 20:57:02
id:ken3memo No.3

回答回数317ベストアンサー獲得回数115

ポイント500pt

XXXXが含まれているセルの数を数え 該当セルの色を変える
処理のサンプル
https://youtu.be/8aCnItxskKM?t=509
↑のような感じでいいのなら

1.ワークシート関数 COUNTIFを使って件数を数える
google:COUNTIF関数←などで、
検索するといろいろな例題が見つかると思います。

ここでは、りんご なので
=COUNTIF(A:A, "*りんご*")
をJ1に式を入れて

2.セルの色を変更したいので、条件書式で

google:条件書式 Excel←などで検索するとわかりやすい使い方が出てくると思います

=COUNTIF(A2,"*りんご*")>0
↑この頭の＝がわかりにくいんだけど、
設定後a2:a10000にする

Excel条件書式 設定方法サンプル
https://youtu.be/8aCnItxskKM?t=254
↑いつもの、操作ミスが多い動画ですが、参考となれば。

以上、手作業でJ1にCountIF関数と条件書式を使ってみては？の案でした。

求めているので、VBA プログラミングのサンプルだったらスミマセン、
この回答はスルーしてください。

少しでも処理の参考となれば幸いです。

id:moon-fondu

動画ありがとうございます！拝見しました。
b1の方法、知らなったです…いいですね、2つの"&"で囲まないといけないんですねー。
条件付き書式は使ったことありましたら、数式を入れるという高度な使い方は初めてです。
countifで1つ以上あると色付け…そんな使い方ができるのは驚きです。
これで色付けも太字化も文字数カウントも達成できますね。

2020/01/30 22:00:07
id:huumm No.4

回答回数8ベストアンサー獲得回数2ここでベストアンサー

ポイント500pt 
Sub test()

Dim i As Long, j As Long

j = 0

For i = 1 To Sheets("Sheet1").Cells(Rows.count, 1).End(xlUp).Row
'1 To 1000　でも可、データ最終行まで処理にしてます

 If InStr(Cells(i, 1), "りんご") > 0 Then
 
  With Cells(i, 1)
  .Font.Bold = True
  .Interior.ColorIndex = 6
  End With
 j = j + 1
 End If

Next i

Range("J1") = j

End Sub

InStr関数は文字列の中をキーワード検索して、見つかると開始位置を返してくれます。
例）Range("A1")=InStr("わたしのりんご","りんご")　→　A1セル：５
みつからないと０を返すので、返ってくる値が１以上であればキーワードがセル上に存在してるのが分かります。詳しくは、InStr関数で検索してみてください。

id:huumm

1000行のデータでは実行してないので、もし重いようでしたらApplication.ScreenUpdating = Falseとかを追記するといいかも…。
https://tonari-it.com/vba-processing-speed/

2020/01/29 00:24:59
id:moon-fondu

すごいです！早いです！ありがとうございます(^^;)

2020/01/30 22:00:14

コメント（1件)

  • id:miharaseihyou
    miharaseihyou 2020/01/27 20:57:10
    マクロの機能でできるけど、どうやるのか忘れたな。
    数十年前の記憶がうっすらと残っている。

この質問への反応（ブックマークコメント）

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません
ユーザー登録をして使いはじめる!無料
すでに登録されている方はこちらからログイン
この質問に含まれるキーワード
知りたいことを検索してみよう
▲ページトップへ