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


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

この状況におきまして。

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

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

回答の条件
  • 1人10回まで
  • 登録:
  • 終了:2020/02/04 20:58:48

ベストアンサー

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セル:5
みつからないと0を返すので、返ってくる値が1以上であればキーワードがセル上に存在してるのが分かります。詳しくは、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
 
シート1のB列、C列、セルJ1に 関数式を設定します。
 
シート2にシート1の内容をコピーして、値の貼り付けをしてから、
C列を基準にして、並べ替えをおこない、
C列のりんごを含む1塊のセル群を黄色く着色します。
C列の書式を太字にしておきます。
 
シート3にシート2の内容をコピー貼り付けします。
列Bを基準にして、昇順に並べ替えを行ってから、
C列の内容を、シート1のA列にコピー貼り付けをします。
 
以上で 求めるデータを得ることができます。
 
 
 

id:moon-fondu

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

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

回答回数4816ベストアンサー獲得回数2072

ポイント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

回答回数287ベストアンサー獲得回数98

ポイント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セル:5
みつからないと0を返すので、返ってくる値が1以上であればキーワードがセル上に存在してるのが分かります。詳しくは、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
  • id:miharaseihyou
    マクロの機能でできるけど、どうやるのか忘れたな。
    数十年前の記憶がうっすらと残っている。

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません