Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


54916 / 76738 ←次へ | 前へ→

【26605】Re:複数シート内の文字列置換について
回答  りん E-MAIL  - 05/7/11(月) 22:30 -

引用なし
パスワード
   ひらごく7 さん、こんばんわ。

>1ブック内に複数シート(4シート:A〜D)が存在したとします。
>2シート(C,D)内に置換対象文字列が複数存在(1セル内に複数及び、
>複数行において)している場合の置換対象方法はどのようにすれば
>よいでしょうか?
>また、置換後の文字列については、太字、16ポイント、赤色で
>置換させたいです。

とりあえず単一のシートを指定して動作します。
同じセルに何度か繰り返して出る可能性があるようなので、Replaceメソッドは使っていません。
Sub test()
  Dim ws As Worksheet, s1 As String, s2 As String, s3 As String
  Dim r1 As Range, II As Integer, p1 As Long, p2 As Long, p3(1 To 100) As Long
  Dim Jmax As Integer, JJ As Integer
  '対象
  Set ws = ThisWorkbook.Worksheets("Sheet1") 'シート名:Sheet1の例
  '
  For II = 1 To 2
   Select Case II
     Case 1: s1 = "あああ": s2 = "いいい"
     Case 2: s1 = "ううう": s2 = "えええ"
   End Select
   
   Do
     Set r1 = ws.Cells.Find(What:=s1)
     If r1 Is Nothing Then Exit Do
     '
     s3 = r1.Value
     Jmax = 0
     p2 = 1 'チェック開始位置
     Do
      p1 = InStr(p2, s3, s1)
      If p1 = 0 Then Exit Do
      Jmax = Jmax + 1
      p3(Jmax) = p1
      p2 = p1 + Len(s1)
      s3 = Left(s3, p1 - 1) & s2 & Mid(s3, p2, Len(s3)) '置換
     Loop
     '置換後文字列
     r1.Value = s3
     'フォントカラー等セット
     For JJ = 1 To Jmax
      With r1.Characters(Start:=p3(JJ), Length:=Len(s2)).Font
        .FontStyle = "太字"
        .Size = 16
        .ColorIndex = 3
      End With
     Next
   Loop
  Next
  Set ws = Nothing:Erase p3
End Sub

置換に関しては、こんな感じです。
配列の宣言上、置換したい文字列が一つのセル内で100回以上出るとエラーになるので、もしもその可能性があるのなら、p3の宣言範囲を広げてください。
複数のシートを処理したい場合は、For eachなどでシートをループしてオブジェクト変数wsにセットしていけば良いです。
0 hits

【26589】複数シート内の文字列置換について ひらごく7 05/7/11(月) 13:57 質問
【26605】Re:複数シート内の文字列置換について りん 05/7/11(月) 22:30 回答
【26661】Re:複数シート内の文字列置換について ひらごく7 05/7/13(水) 11:42 お礼

54916 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free