Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9567 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【26589】複数シート内の文字列置換について ひらごく７ 05/7/11(月) 13:57 質問[未読]
【26605】Re:複数シート内の文字列置換について りん 05/7/11(月) 22:30 回答[未読]
【26661】Re:複数シート内の文字列置換について ひらごく７ 05/7/13(水) 11:42 お礼[未読]
【26589】複数シート内の文字列置換について
質問  ひらごく７  - 05/7/11(月) 13:57 -
引用なし
パスワード
   お疲れ様です。ひらごく７と申します。
上記、標題の件について質問があります。

１ブック内に複数シート(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 = "ＭＳ ゴシック"
　　　　.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 -
引用なし
パスワード
   ひらごく７ さん、こんばんわ。

>１ブック内に複数シート(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

置換に関しては、こんな感じです。
配列の宣言上、置換したい文字列が一つのセル内で１００回以上出るとエラーになるので、もしもその可能性があるのなら、p3の宣言範囲を広げてください。
複数のシートを処理したい場合は、For eachなどでシートをループしてオブジェクト変数wsにセットしていけば良いです。
【26661】Re:複数シート内の文字列置換について
お礼  ひらごく７  - 05/7/13(水) 11:42 -
引用なし
パスワード
   ▼りん さん：
ひらごく７です。こんにちは。

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

また、何かわからないことがあったら
是非、ご教授願います。
本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9567 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free