Excel VBA質問箱 IV

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

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


9565 / 13644 ツリー ←次へ | 前へ→

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

【26589】複数シート内の文字列置換について
質問  ひらごく7  - 05/7/11(月) 13:57 -

引用なし
パスワード
   お疲れ様です。ひらごく7と申します。
上記、標題の件について質問があります。

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

 1.置換対象文字列:あああ
 1.置換後文字列:いいい 

 2.置換対象文字列:ううう
 2.置換後文字列:えええ

 Cシート:1行目2列目のセル内に「あああ」が2箇所存在
     5行目2列目のセル内に「あああ」が1箇所存在
     8行目2列目のセル内に「ううう」が3箇所存在
     10行目2列目のセル内に「ううう」が1個所存在

 Dシート:3行目2列目のセル内に「あああ」が2箇所存在
     6行目2列目のセル内に「あああ」が1箇所存在
     9行目2列目のセル内に「ううう」が3箇所存在
     11行目2列目のセル内に「ううう」が1個所存在

現在、途中ではありますが以下のロジックを考えております。
'入力情報シート初期(開始行)項目取得
sMotoMoji = Worksheets(入力情報シート名).Cells(nInSheetGyo, nInSheetMotoRetsu)
sSakiMoji = Worksheets(入力情報シート名).Cells(nInSheetGyo, nInSheetSakiRetsu)
  
'可変部分入力マクロのシート数を数える
nToolSouShtCnt = ActiveWorkbook.Sheets.Count
  
'コピーシート数分ループ
Do While nToolSouShtCnt - nToolShtEndCnt > 0
  Do While sMotoMoji <> "" And sSakiMoji <> ""
  Sheets(Worksheets(nLoopCnt).Name) = Workbooks(ツール名).Sheets(nToolSouShtCnt)
    
  '一括置換
  Cells.Replace What:=sMotoMoji, Replacement:=sSakiMoji, LookAt _
  :=xlPart, SearchOrder:=xlByRows, MatchCase:=False

  'シート内全検索文字分ループ
  Do
    '変換後文字列検索
    Cells.Find(What:=sSakiMoji, After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False).Activate
  Loop
      
  '置換後文字列変更
  With ActiveCell.Characters(Start:=n, Length:=m).Font
    .Name = "MS ゴシック"
    .FontStyle = "太字"
    .Size = 14
    .ColorIndex = 3     '赤
  End With
    
  nToolShtEndCnt = nToolShtEndCnt + 1
  nLoopCnt = nLoopCnt + 1
  nInSheetGyo = nInSheetGyo + 1
  '入力情報シート初期(開始行)項目取得
  sMotoMoji = Worksheets(入力情報シート名).Cells(nInSheetGyo, nInSheetMotoRetsu)
  sSakiMoji = Worksheets(入力情報シート名).Cells(nInSheetGyo, nInSheetSakiRetsu)
  Loop
Loop

【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にセットしていけば良いです。

【26661】Re:複数シート内の文字列置換について
お礼  ひらごく7  - 05/7/13(水) 11:42 -

引用なし
パスワード
   ▼りん さん:
ひらごく7です。こんにちは。

りんさんから教えていただいたロジックを元に作成しました。
複数シートもループロジックを加え無事問題解決です!
ありがとうございました。
りんさんのロジックがなかったら今でも頭を悩ましていました。

また、何かわからないことがあったら
是非、ご教授願います。
本当にありがとうございました。

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