エクセル2002のVBAで太文字を検索する方法

このQ&Aのポイント
  • エクセル2002のVBAを使用して、指定のセル範囲から太文字を検索し、別のセルに抜き出す方法を紹介します。
  • 「太字検索チェック1」マクロを使用すると、指定のセル範囲の太文字を抜き出して指定のセルにコピーすることができます。
  • また、「太字検索チェック2」では、セル内の文字を1文字ずつ確認し、太文字の場合に別のセルにコピーすることができます。
回答を見る
  • ベストアンサー

エクセル2002のVBAで太文字を検索したいのですが、

エクセル2002のVBAで太文字を検索したいのですが、 <状況> B列にチェックしたい文字が入力されています <やりたいこと> B列に入力されている文字の中から、太文字のみを抜き出して、 太字の見つかった行のG列に太文字のみを抜き出して複写したい <自作マクロの現状> セル全体の太文字検索は下記のマクロ「太字検索チェック1」で完成しましたが、 セルに記載してある文字の中で「一部は普通文字、のこり一部は太文字」と混在 しているセルの中身から太文字部分のみを別のセルに抜き出したいのですが、 そのマクロを「太字検索チェック2」のように書きました。 しかし「太字検索チェック2」の「 If dat.Font.Bold = True Then」の部分で 「型が違う・・・」のエラーで先に進みません。 どなたか、セルの中身の太文字のみを抜き出すマクロを教えてください よろしくお願いします   Sub 太字検索チェック1() i = 3 Worksheets("テスト").Activate For Each myRng In Range("B:B") セル = "b" & i If Range(セル).Font.Bold = True Then Cells(i, 7) = Cells(i, 2) ’太字のCells(i, 2)を Cells(i, 7) にコピー End If i = i + 1 If i = 1703 Then ’1703番地で終了 Exit For End If Next End Sub Sub 太字検索チェック2() i = 3 Worksheets("テスト").Activate For Each myRng In Range("B:B") 内容 = Cells(i, 2) 文字数 = Len(内容) For p = 1 To 文字数 dat = Mid(内容, p, 1)       X=8+P If dat.Font.Bold = True Then  ’1文字づつ太字を検索 Cells(i, X) = dat        ’太字なら→Cells(i, X) にコピー End If Next i = i + 1 If i = 1703 Then Exit For End If Next End Sub

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

  • ベストアンサー
  • kmetu
  • ベストアンサー率41% (562/1346)
回答No.2

For P = 1 To 文字数 X = 8 + P If Cells(i, 2).Characters(P, 1).Font.Bold = True Then Cells(i, X) = Cells(i, 2).Characters(P, 1).Text End If Next に変更してください。

kame1010
質問者

お礼

ご指導ありがとうございました

その他の回答 (1)

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

変数の宣言部分が無いようですね。 Option Explicitを宣言する習慣付けしたほうが良いですよ。 問題が生じるのは、 > dat = Mid(内容, p, 1) と代入した変数 dat に Font がぶら下がって無いから。 過去問の「Excel文字列中の太字(Bold)部分のみ文字色を一括して変換する方法」が 参考になると思います。

参考URL:
http://okwave.jp/qa/q2965758.html

関連するQ&A

  • エクセルVBAで、文字列の検索方法について

    先日、こちらで教えていただいたVBAがあります。 E列のセルの文字列の末尾が「計」のものを検索し、その行に色をつけるものです。 Sub iroiro() Dim x, y x = 1 Do If Right(Cells(x, 5), 1) = "計" Then For i = 2 To 5 Cells(x, i).Interior.ColorIndex = 3 Next End If x = x + 1 Loop Until Right(Cells(x, 5), 1) = "" End Sub これはばっちりで、助かっているのですが、今度は末尾ではなく、文字列中に「営業」という文字があるのを検索し、色をつけたいのです。 If Right(Cells(x, 5), 1) = "計" Thenを どう変えればいいのでしょうか?

  • エクセルマクロで特定の範囲内の検索

    A10からA100までのセルを上から順に調べて、セルにAという文字が入力されているときに、その隣にBという文字を入力するマクロを下記のように作りました。 「セルにAという文字が入力されているとき」という条件に加え、「検索しているセルから上の9個のセル(cells(i-9,1)からcells(i-1,1)まで)にAという文字が入力されていない」という条件を加えたいのです。 Sub 検索() Dim i As Integer For i = 10 To 100 If Cells(i, 1).Value = "A" Then Cells(i, 2).value = "B" End If Next i End Sub つまり If Cells(i, 1).Value = "A" Then  の部分を If Cells(i, 1).Value = "A" かつ Range(cells(i-9,1),cells(i-1,1))にAが入力されていない Then という形にしたいのですが、表現の仕方がわかりません。 ご教示よろしくお願いします。

  • vba検索結果を保持しつつ、次の検索結果が欲しい

    a列にあるセルがe列にないか検索し、あった場合は、b列にあるセルがf列にないか検索し、あった場合は、c列にあるセルがg列にないか検索し、あった場合は、c列とg列が合致した2つ隣のセル(i列)に、d列にあるセルとh列にあるセルを結合させた結果を、表示させたいです。 以下のコードを走らせましたが、何も起こりませんてした。 お手数ですが、ご教示いただけますと幸いですm(_ _)m sub merge () dim i as long for i = 1 to cells(rows.count,1).end(xlup).row if cells(i,1) = cells(i,5) then if cells(i,2) = cells(i,6) then if cells(i,3) = cells(i,7) then cells(i,7).offset(0,2) = cells(i,4) and cecls(i,8) i = i + 1 end if end if end if next end sub

  • エクセルVBA 文字の置き換え

    Sub あ() For i = 1 To 100 If Cells(i, 1).Value Like "*解約*" Then Cells(i, 1).Interior.Color = vbRed Next i End Sub A列にA100まで、文章が入っています。 その文章のなかに”解約”という文字の入った文章の入ったセルだけを赤く塗りつぶすマクロ を作りました。 しかし、本当は、”解約”を”解除”という文字に置き換えるマクロが 作りたいのですが、どうしたらいいのでしょうか?

  • エクセルVBAラベルの変数?

    エクセル2000VBAにて下記のように作成しました。 With ActiveSheet For i = 4 To 200 If Label1.Caption = .Cells(i, 1) Then For h = 4 To 34 If Label25.Caption = .Cells(2, h) Then For idx = i To 200 If .Cells(idx, 3) = Label21.Caption Then Label6.Caption = .Cells(idx, h) Label7.Caption = .Cells(idx + 2, h) GoTo ラベル2 End If Next idx End If Next h End If Next i ラベル2: For i = 4 To 200 If Label2.Caption = .Cells(i, 1) Then For h = 4 To 34 If Label25.Caption = .Cells(2, h) Then For idx = i To 200 If .Cells(idx, 3) = Label21.Caption Then Label8.Caption = .Cells(idx, h) Label9.Caption = .Cells(idx + 2, h) GoTo ラベル3 End If Next idx End If Next h End If Next i ラベル3: ・・・ End With Label1~5まで同じ処理を行うため 1~5まで変数を使用して簡単にしたいのですが Label(変数)の書き込み方がわかりません? 検索を使用しましたが検索項目が悪いのか なかなか解決しません。 何方か教えていただけないでしょうか?

  • Excel VBAで検索(Win2000 Excel2000)

    現在、下記のようなコードを書いています。データテーブルの縦と横の検索値を探してその列数と行数を返したいのですが、下記の Sub検索1 と Sub検索2 を1つのSubで実行させるにはどうしたらよいのでしょうか?よろしくお願い致します。 ----------------------------------------- Sub 検索1() Worksheets("Data").Activate Dim x As Integer For x = 3 To 22 If Cells(2, x).Value >= 12 Then MsgBox x Exit Sub End If Next MsgBox "見つかりません" End Sub --------------------------------------------- Sub 検索2() Worksheets("Data").Activate Dim i As Integer For i = 4 To 42 If Cells(i, 2).Value = "A" Then MsgBox i Exit Sub End If Next MsgBox "見つかりません" End Sub

  • Excel VBAで、様々な書式設定のセルをyyyymmddの文字列に

    Excel VBAで、様々な書式設定のセルをyyyymmddの文字列にしたい dim i Columns("A:B").NumberFormatLocal = "@" For i = 1 To 5 If Cells(i, 1)NumberFormat = "@" Then Cells(i, 2) = Aells(i, 1).text Else Cells(i, 2) = Application.text(cells(i, "1"), "yyyymmdd") End If Next Excel VBAで、様々な書式設定のセルをyyyymmddの文字列にしたいのですが・・ 上記のソースを書いた場合、文字列・日付・ユーザ定義などの書式設定ではうまくいきますが、標準で19990101などと入力されていた場合はエラーになってしまいます。 どのように直せばうまくいくのでしょうか? よろしくお願いします。

  • エクセルのVBA、ループ処理について

    if文とループ処理をどう組み合わせればいいのかわかりません 以下のコードで、iの数をを増やしていく処理を行いたいのですが、エラーがでてしまいうまくいきません どのように書けばいいのでしょうか 教えてください For i = 2 To 11 If Cells("4,i") > 80 Then Cells("5,i").Value = "A" ElseIf Cells("4,i") > 70 Then Cells("5,i").Value = "B" ElseIf Cells("4,i") > 60 Then Cells("5,i").Value = "C" Else Cells("4,i").Value = "D" End If Next

  • ExcelのVBAがオーバーフローに!?

    読んで頂きありがとうございます。 以前に質問しました時に回答を頂き凄く助かっていたのですが、何故か「オーバーフロー」と表示されてしまいます。 ひょっとしたら桁なのかも知れません。 下記のVBAを教えて頂きしようしていました。 Option Explicit Sub Test() Dim c(), p(), q(), i, j, l, r, k As Long r = Range("B2").End(xlDown).Row l = Range("D2").End(xlDown).Row ReDim c(r - 2), p(r - 2), q(r - 2) For i = 1 To r - 2 c(i) = Cells(i + 2, 2).Value p(i) = Cells(i + 2, 3).Value q(i) = i + 2 Next i For i = 1 To r - 3 For j = i + 1 To r - 2 If c(i) > c(j) Then k = c(i) c(i) = c(j) c(j) = k k = p(i) p(i) = p(j) p(j) = k k = q(i) q(i) = q(j) q(j) = k End If Next j Next i For i = 1 To r - 2 Cells(i + 2, 7).Value = c(i) For j = 3 To r If Cells(j, 4).Value = c(i) Then Cells(i + 2, 8).Value = p(i) - Cells(j, 5).Value If p(i) - Cells(j, 5).Value <> 0 Then Range("B" & q(i)).Interior.ColorIndex = 6 Range("D" & j).Interior.ColorIndex = 6 End If Exit For End If Next j Next i For i = 3 To r k = 0 For j = 3 To l If Cells(i, 2).Value = Cells(j, 4).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("B" & i).Interior.ColorIndex = 35 End If Next i For i = 3 To l k = 0 For j = 3 To r If Cells(i, 4).Value = Cells(j, 2).Value Then k = 1 Exit For End If Next j If k = 0 Then Range("D" & i).Interior.ColorIndex = 35 End If Next i End Sub デパックのClickすると15行目辺りの「k = c(i)」が黄色くなります。 正直言ってマクロとか全く解りませんが、コピーして使っていました。 どこをどう変更すれば良いのか教えて頂ければ助かります。 よろしくお願いします。

  • 連続データのVBAの質問

    お世話になります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Range("C1") <= Date - Day(Date) Then Exit Sub If Not Intersect(Target, Range("C1,B9:B39")) Is Nothing And Target.Count = 1 Then Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, Range("R8:R38")) Is Nothing Then Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End If End Sub これはセルC1に年月を表記させ、そのC1セルの年月を変更した場合B9~B39のセルが自動で連続データの数字を記入し、B9~B39のどこかのセルを空白にすると、そのセル以降も空白になります。 そこで質問ですが、例えばB14の数字を消すとB15~39まで空白のセルになります。そして、B20に1と入力するとB21~39に連続データの数字が自動記入されます。 そしてC1の年月を次の月に更新した際は、B39で示された数字以降の連続データをB9に表示させるには、どうすれば良いでしょうか?

専門家に質問してみよう