こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

Excel 文字列を検索して全て置換するマクロ

当方VBA初心者なのですが、ExcelのVBAで作ったマクロでうまく動かなくて困っています。
もしおわかりになる方がいらっしゃったら是非よろしくお願いいたします。

*実現したいこと
'”reference”という名前のシートに、次のようなデータが入っています。

(1) りんご
(2) みかん
(3) キウイ
・・・
これを、配列を2つ用意し、
(1)を配列Listに、(2)を配列List2へ格納して行きます。

'"data"という名前のシートには、A列の1~10行目までに文章が入っていて、
"家には、(1)があります。"
"冬になるとよく(2)を食べます。"
・・・・
この全文をcというRangeに設定し、そのcの中において、
もし、配列1((1)等)のキーワードがあったら、
'そのキーワードを配列2(りんご等)の内容に書き換える。
'キーワードは、データシートに複数回出てくる場合もある。

*困っていること
下記のマクロだと、一度目のObjFindまでは成功するのですが、
List(i)を探しているはずが、2回目から、その変更後の文字列が含まれた全文を検索するようになってしまいます。

以下マクロです。
よろしくお願いいたします。

Sub TEST()
Dim List() As String, List2() As String 'List
Dim i As Integer
Dim iRow As Integer
iRow = Worksheets("reference").Cells(Rows.Count, 1).End(xlUp).Row
ReDim List(iRow)
ReDim List2(iRow)
For i = 1 To iRow
List(i) = Worksheets("reference").Cells(i, 1).Value
List2(i) = Worksheets("reference").Cells(i, 2).Value
Next i

Dim lngYLine As Long
Dim intXLine As Integer
Dim objFind As Object
Dim strAddress As String
Dim strSamp As String
Dim objRange As Range
Dim c As Range

For i = 1 To iRow
Set objRange = Worksheets("data").Range("A1:A331")
Set objFind = objRange.Cells.Find(List(i))
If Not objFind Is Nothing Then
For Each c In objRange
If c.Value = objFind Then
lngYLine = objFind.Cells.Row
intXLine = objFind.Cells.Column
strSamp = Worksheets("data").Cells(lngYLine, 1)
strSamp = Replace(strSamp, List(i), List2(i))
Worksheets("data").Cells(lngYLine, 1) = strSamp
MsgBox List(i) + "は" + List2(i) + "に変更されました"
Set objFind = Cells.FindNext(objFind)
End If
Next c
Else
MsgBox List(i) + "は見つかりませんでした"
End If
Next i
End Sub

投稿日時 - 2013-10-06 11:32:58

QNo.8293972

すぐに回答ほしいです

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

#1です。

>このコードについてですが、あらかじめ配列に格納してということではなくて、
>その場で、A列とB列を読み込んで、セルを全て参照し、変更するべきものがあったら置換するという解釈であっていますでしょうか。

その認識で合っています。

(1列目から順番に)
変数w1にA列の値、w2にB列の値をそれぞれ格納

w1を検索(Find使用)

見つかった場合w2へ置換(Replace使用)の後変更されましたとMsgbox表示
見つからない場合は見つかりませんでしたとMsgbox表示のみ

次の行に移動しw1、w2の値を再設定(以下referenceの行数分繰り返し)

のような流れになります。
#2の方も書かれていますが、やはりReplaceを使用した方が少ないステップで済むので
後で混乱してしまうような可能性も低いかと思います。。。

最後に追伸ですが申し訳ありません、前回#1の回答の前半部分はやはり再検証した結果何点かまだ不具合が発生してしまいましたので、その部分はスルーしてください。。m(_ _)m
(回答の編集や削除が出来ないのはやはり不便ですね 苦笑)

投稿日時 - 2013-10-07 00:19:13

ANo.4

#2、cjです。

単に置換するということで、必要ないものを削って、シンプルに書き直してみました。
List配列については、配列変数の代りに、Cells 配列で直接取得します。
見つからない場合の判別をする為には、.Find メソッドは省けません。
.Find メソッドで指定が済んだ引数(LookAt)は、
.Replace メソッドについては引数を省略できます。
一度しか使わない値については、変数を使わず直値にしています。
referenceシートへの参照は、With フレーズでブロック化しています。
リスト範囲に空セルはない、という前提が確実なら、◆の2行は不要です。

' ' =================================

Sub Re8293972a()
  Dim objRange As Range
  Dim i As Long

  Set objRange = Worksheets("data").Range("A1:A331")

  With Worksheets("reference")
    For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
      If .Cells(i, 1) <> "" Then  '  ◆
        If objRange.Find(What:=.Cells(i, 1), LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
          MsgBox """" & .Cells(i, 1) & """ は見つかりませんでした"
        Else
          objRange.Replace What:=.Cells(i, 1), Replacement:=.Cells(i, 2)
          MsgBox """" & .Cells(i, 1) & """ は """ & .Cells(i, 2) & """ に変更されました"
        End If
      End If  '  ◆
    Next i
  End With

  Set objRange = Nothing
End Sub

' ' =================================


メッセージボックスの表示が不要になったり、
リスト範囲に空セルはない、という前提が確実なら、
もっとずっとシンプルに


' ' =================================

Sub Re8293972b()
  Dim objRange As Range
  Dim i As Long

  Set objRange = Worksheets("data").Range("A1:A331")

  With Worksheets("reference")
    For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
      objRange.Replace What:=.Cells(i, 1), Replacement:=.Cells(i, 2), LookAt:=xlPart
    Next i
  End With

  Set objRange = Nothing
End Sub

' ' =================================

みたいになります。

以上です。

投稿日時 - 2013-10-06 19:57:12

ANo.3

こんばんは!
横からお邪魔します。

こういうコトでしょうかね?
↓の画像で上側が「data」Sheet、下側が「reference」Sheetとします。
元々画像の「data」SheetのA列がC列のようになっていて
マクロ実行後はA列のように「置換」したい!という解釈での一例です。

Sub Sample1()
Dim i As Long, k As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("data")
Set wS2 = Worksheets("reference")
Application.ScreenUpdating = False
For i = 1 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
For k = 1 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
If InStr(wS1.Cells(i, "A"), wS2.Cells(k, "A")) > 0 Then
wS1.Cells(i, "A") = Replace(wS1.Cells(i, "A"), wS2.Cells(k, "A"), wS2.Cells(k, "B"))
End If
Next k
Next i
Application.ScreenUpdating = True
End Sub

※ メッセージボックスはその都度マクロが止まってしまうので、敢えて表示させていません。
※ 的外れならごめんなさいね。m(_ _)m

投稿日時 - 2013-10-06 19:27:23

ANo.2

こんにちは。

やりたいこと、が、いまひとつ解らないのですが、
こんなことをやりたいのかな?、というマクロを例として挙げてみます。

通常、置換に関しては、
.Replace メソッドを用いてセル範囲に対して[すべて置換]するか、
セル範囲すべてをループして、セルひとつずつの.Valueを変更していくか、
主に2つの方法があります。
特別な条件がないなら、検索する文字列ごとに[すべて置換]すればいいように思います。
.Find メソッドを使うなら、.Replace メソッドで置換するのが自然で、統一感もあります。
何か理由があってセルひとつずつをループするのでしょうか?
この理由が、判らないので、どう答えていいか迷いましたが、
一例として、
置換したセル範囲の.Addressを添えて、「何処の何を何に換えたか」
を表示するように書いてみました。
これなら、セルひとつずつループしたかった理由も説明できるかな?と思いましたので。
ただ、置換に関してはやはり、.Replace メソッドを用いて一括する方が速くて効率的ですし、
置換したセル範囲の.Addressを採るのも、
.Find メソッド、.FindNext メソッドで抽出されたセルだけを相手にする方が無駄が無いですから、
そのように書いています。
もっとも、沢山の書き方がある中での一例ですから、
.Find メソッド、.Replace メソッド、どちらも使わなくても、
同様の処理は可能なのですが、
そこら辺は要求仕様がもう少しハッキリしてから、必要性があれば、また考えてみるかも知れません。

取り敢えず、試してみて、実行結果と、求める結果、との間に、どんな違いがあるのか、
補足でも貰えれば、今よりはこちらの理解も進むと思いますので。

' ' ============ 標準モジュール ============

Sub Re8293972()
  Dim objRange As Range
  Dim objFind As Range
  Dim mtxTable As Variant
  Dim strAddress As String
  Dim iRow As Integer
  Dim n1stRow As Integer
  Dim i As Integer
  
  With Worksheets("reference")
    iRow = .Cells(Rows.Count, 1).End(xlUp).Row
    mtxTable = .Range("A1:B" & iRow).Value
  End With
  
  Set objRange = Worksheets("data").Range("A1:A331")
  For i = 1 To iRow
    If mtxTable(i, 1) <> "" Then
      strAddress = ""
      Set objFind = objRange.Find(What:=mtxTable(i, 1), After:=objRange(objRange.Count), _
                    LookIn:=xlValues, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, MatchByte:=False)
      If Not objFind Is Nothing Then
        n1stRow = objFind.Row
        Do
          strAddress = strAddress & "," & objFind.Address(0, 0)
          Set objFind = objRange.FindNext(objFind)
          If objFind Is Nothing Then Exit Do
        Loop While objFind.Row > n1stRow
        objRange.Replace What:=mtxTable(i, 1), Replacement:=mtxTable(i, 2)
        MsgBox Mid(strAddress, 2) & vbLf & """" & mtxTable(i, 1) & """ は """ & mtxTable(i, 2) & """ に変更されました"
      Else
        MsgBox mtxTable(i, 1) & " は見つかりませんでした"
      End If
    End If
  Next i
End Sub

' ' =================================

投稿日時 - 2013-10-06 14:48:12

補足

ご回答いただきありがとうございます。m(_ _)m
要求条件が明確でなくてすいません、

当方がやりたいことは、
dataシートの中に入っているセル全てに検索をかけて、
(1)をみつけたら、”りんご”と全てを置換するということです。

ご提示いただいた、2つの方法のうち、
・.Replace メソッドを用いてセル範囲に対して[すべて置換]するか、
・セル範囲すべてをループして、セルひとつずつの.Valueを変更していくか、

私自体が、後者しか方法を知らなかったため、最初から最後までをループして探し出してみていくような形でかいていました。
Range("A1:A331").Replace What:=List(i), Replacement:=List2(i), LookAt:=xlPart, MatchCase:=True
というような形で記載になりますでしょうか。。

そして、マクロのご提示ありがとうございます。
動かしてみます。

投稿日時 - 2013-10-06 18:49:35

ANo.1

>一度目のObjFindまでは成功するのですが、
>List(i)を探しているはずが、2回目から、その変更後の文字列が含まれた全文を検索するようになってしまいます。

という現象がよく分からなかったのですが(こちらで同様の検証をしたところ、2回目以降はエラーで止まってしまいました)、例えば質問文内のFor Each c In objRange~Next cの箇所を

If Not objFind Is Nothing Then
If c.Value = objFind.Value Then
lngYLine = objFind.Cells.Row
intXLine = objFind.Cells.Column
strSamp = Worksheets("data").Cells(lngYLine, 1)
strSamp = Replace(strSamp, List(i), List2(i))
Worksheets("data").Cells(lngYLine, 1) = strSamp
MsgBox List(i) + "は" + List2(i) + "に変更されました"
End If
Set objFind = Cells.FindNext(objFind)
End If

(※If Not objFind Is Nothing Then の記述を2回使用することになります。2回目の記述は1件目が見つかって置換された際の次回以降の分岐になります)
としてみても解決しないでしょうか?

また余談ですが、私自身も以前質問者様と似たような処理を行うマクロを作成したことがあるので、
その時のコードを少し修正してみました。

Sub test2()

Dim h As Long
Dim i As Long
Dim w1 As Variant
Dim w2 As Variant
Dim c As Range

h = Sheets("reference").Range("A" & Rows.Count).End(xlUp).Row

Set objRange = Sheets("data").Range("A1:A331")

For i = 1 To h
w1 = Sheets("reference").Range("A" & i).Value
w2 = Sheets("reference").Range("B" & i).Value

Set c = objRange.Cells.Find(what:=w1, lookat:=xlPart)

If Not c Is Nothing Then
objRange.Cells.Replace what:=w1, Replacement:=w2, lookat:=xlPart
MsgBox w1 + "は" + w2 + "に変更されました"
Else
MsgBox w1 + "は見つかりませんでした"
End If

Set c = Nothing
Next

End Sub

上記でも似たような処理が可能かと思います(見当違いでしたらすみません)

投稿日時 - 2013-10-06 14:36:57

補足

ご回答いただきましてありがとうございます。m(_ _)m

後半にご記載いただいたマクロで動かしてみましたら、
理想に近い動き方をしていました!
明日、改めて本物のデータで確認してみたいと思います。

このコードについてですが、あらかじめ配列に格納してということではなくて、
その場で、A列とB列を読み込んで、セルを全て参照し、変更するべきものがあったら置換するという解釈であっていますでしょうか。

よろしくお願いいたします。

投稿日時 - 2013-10-06 22:44:43

あなたにオススメの質問