ExcelVBAでの文字列置換について

質問

ExcelVBAでの文字列置換について

ExcelVBAは全く初心者のですが、下記の処理を早急に行う必要があり、質問させていただきます。

物品の使用者をエクセル管理しています。

シート１のA列に物品名、B列に現使用者名を入力しています。（約2000件）

一部の使用者に変更があった場合に、シート２に振替リストを

シート２　A列＝現使用者　B列＝新使用者

と作成しています。

シート１のB列：現使用者から、シート２のA列：現使用者と同一な文字列を検索し、シート２B列：新使用者に置換するマクロはどのように書けばよいのでしょうか？

可能であれば、シート２のC列に置換結果を表示させたいです。

回答No.1

end-u · ベストアンサー

シート２の振替リストには

現使用者　新使用者
田中　　　佐藤
鈴木　　　田中
佐藤　　　鈴木
：
こういう可能性もありますよね。
ダイレクトにまとめて置換する場合、
その順番にも気をつけないといけないパターン。
（田中→佐藤のあとに佐藤→鈴木とやると結果的に田中→鈴木になる）

また、
>可能であれば、シート２のC列に置換結果を表示させたいです。
置換対象はシート１なのでシート１のC列ではないですか？

そうだと仮定すると、数式を使ったほうが良さそう。
Sub test()
　　Dim mx As Long

　　With Sheets("シート２")
　　　　mx = .Cells(.Rows.Count, 1).End(xlUp).Row
　　End With
　　With Sheets("シート１")
　　　　With .Range(.Range("B2"), _
　　　　　　　　　　.Cells(.Rows.Count, 2).End(xlUp)).Offset(, 1)
　　　　　　.Formula = "=IF(ISNA(MATCH(B2,シート２!$A$2:$A$" & mx & ",0))" _
　　　　　　　　　　 & ",B2,VLOOKUP(B2,シート２!$A$2:$B$" & mx & ",2,0))"
　　　　　　'.Value = .Value '値化したい場合はコメントを活かす。
　　　　End With
　　End With
End Sub

補足

回答ありがとうございます。

振替順にまで考慮していただき、ありがとうございます。
現状では、アクセスで突合したり、VLOOKUP関数を使って、シート１を再作成しています。なんと効率よくしたいと思って質問いたしました。

>可能であれば、シート２のC列に置換結果を表示させたいです。
＞置換対象はシート１なのでシート１のC列ではないですか？

説明不足ですみません。「シート２のC列に置換結果を表示」とは、「置換完了」や「置換対象なし」というチェックを表示したかっただけなんです。シート２の現使用者が、シート１の現使用者にない可能性があるためです。

早速、明日、回答いただいたマクロを試してみたいと思います。

回答No.4

end-u

>なので結局は使用者の振替だけでは、新リストが完成しないんです。
#げげっ X(
#そんな中途半端な仕様でボクらに何を期待してたんだろう...
#って心の声。

さておき、振替リストを作る必然性を免れないならば
方向性にそれほど変更はありません。

Ａ　　　　Ｂ　　　　Ｃ　　　　Ｄ
振替項目　変更前　　変更後　　置換結果
担当者　　砂糖　　　塩田　　　置換完了
：
配置場所　キッチン　リビング　置換対象なし

こんなんで置換リストを作らなければ業務がたちゆかないならば
提案の延長と応用です。
シート２のＡ列に振替項目の名称を入力するとして、その振替項目をキーに
シート１の１行目（？）の項目行の何列に当たるか見に行って、
シート１の置換対象の列を変動させつつ置換作業を行えば良いです。

実コードの提示は勘弁してください。
効率悪いと思うので。

しかしながら
>物品をキーとした振替リストを作って、...
>（物品名は重複しないはずです・・・）
これはもはや「置換」とは言わず。
キーを設定した「更新」作業です。

この時、更新前と更新有無の履歴保存が必要なのかどうか
業務的に確認してください。
更新データをどのような手順、経路で作るのか、も関係してきます。

別途に更新項目と更新データなどのテーブルがあって、
それを一括で元データに反映させたいのか、
それとも
何らかのキーを元に１レコード呼び出して、
更新項目を手作業で変更していくアプローチが良いのか、
データの更新手順、つまり業務のすすめ方によって随分と変わってきます。

それによっては
Accessで更新クエリを活用したほうが良かったり、
Excelでも１レコードごとの更新作業で行ったりとか、
最適な手法を選択されたほうがよろしいかと思います。

現在の
【仕様が揺れてる状態】、かつ【詳細な要件が不明な状態】
では最適なアドバイスはできません。

その辺りの事を整理されて、
テクニカルな面で解らない部分をピンポイントに再質問をなさったほうが
よろしいのではないでしょうか。
シート名や項目名、セルアドレス、データ量、少量のサンプルデータ、
希望する処理結果、などの提示があればひょっとしたら親切な方から
サラっとお望みのコードがフルスペックで提示される事もあるかも
しれませんが、あまり過度な期待はなさらないほうが良いかと思います。
Ａがつく待ち日数ももったいないので、
ご自分で試行錯誤なさりつつ、少しでも前に進んだほうが吉かと。

>ご迷惑ついでに、何かアドバイスいただけると助かります。
何かのアドバイスになってたら幸いです。

お礼

ありがとうございます。

今回のアドバイスを参考に試行錯誤してみます。

あいまいな質問にもかかわらず、ご丁寧に回答いただきまして、ありがとうございました。

回答No.3

end-u

ぁ、そうそう。
>ダイレクトにまとめて置換する場合、
>その順番にも気をつけないといけないパターン。
って書きましたけど、Replaceできないと言ってるわけじゃないです。
何事も工夫次第。

Sub test2()
　Dim rList As Range
　Dim r　　 As Range

　With Sheets("シート２")
　　Set rList = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
　　With rList.Offset(, 2)
　　　.Formula = "=IF(ISNA(MATCH(A2,シート１!B:B,0))" _
　　　　　　　 & ",""置換対象なし"",""|"")"
　　　.Value = .Value
　　End With
　End With
　With Sheets("シート１")
　　With .Range(.Range("B2"), .Cells(.Rows.Count, 2).End(xlUp))
　　　For Each r In rList
　　　　If r.Offset(, 2).Value = "|" Then
　　　　　.Replace r.Value, "|" & r.Offset(, 1).Value, xlWhole
　　　　End If
　　　Next
　　　.Replace "|", "", xlPart
　　End With
　End With
　rList.Offset(, 2).Replace "|", "置換完了", xlWhole
　Set rList = Nothing
End Sub

ついでに。
数式に拘るわけではないですが、
なんか課題出されたような気がしたんで？

Sub test3()
　With Sheets("シート２")
　　With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 2)
　　　.Formula = "=IF(ISNA(MATCH(A2,シート１!B:B,0))" _
　　　　　　　 & ",""置換対象なし"",""置換完了"")"
　　　'.Formula = "=COUNTIF(シート１!B:B,A2)"
　　　.Value = .Value
　　End With
　End With
　With Sheets("シート１")
　　With .Range(.Range("B2"), _
　　　　　　　　.Cells(.Rows.Count, 2).End(xlUp)).Offset(, 1)
　　　.Formula = "=IF(ISNA(MATCH(B2,シート２!A:A,0))" _
　　　　　　　 & ",B2,VLOOKUP(B2,シート２!A:B,2,0))"
　　　.Offset(, -1).Value = .Value
　　　.ClearContents
　　End With
　End With
End Sub

Loop不要で、簡単に処理でき、比較的取り組み易いです。

お礼

ありがとうございます。

本日、ご回答no.1を試してみました。
とても効率化がはかれました。

ただ、物品には、使用者の情報だけでなく、配置場所やその他情報（列）がたくさんあり、付随する情報もそれぞれ変更があるんです。なので結局は使用者の振替だけでは、新リストが完成しないんです。

物品をキーとした振替リストを作って、VLOOKUPくらいしか私には思いつきません。（物品名は重複しないはずです・・・）

ご迷惑ついでに、何かアドバイスいただけると助かります。

回答No.2

Wendy02

#1さんの回答は、これ以外ないというぐらいの正解なのですが、それを、Sheet2 のC列にその交換した記録を残すということは、数式では思ったようにはいかないような気がします。できるなら、#1さんに完成してもらいましょう。

出来ないわけではないと思いますが、私は、逆に、そういうことが面倒なのです。最初から、マクロ形式でやっていったほうが良い……。とは言うものの、それが簡単には行かない、というわけです。久々の面白い内容だなって思いました。

//
Sub ReplaceTest()
　Dim Sh1 As Worksheet
　Dim Sh2 As Worksheet
　Dim i As Long
　Dim k As Long
　Dim r As Range, rng As Range
　Dim n As Variant, c As Variant
　Dim FAdd As String

　Set Sh1 = Worksheets("Sheet1") 'データシート
　Set Sh2 = Worksheets("Sheet2") '置換データシート
　With Sh2
　　Set rng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
　　rng.Offset(, 2).ClearContents 'C列を消去
　End With
　Application.ScreenUpdating = False
　With Sh1.Range("B2", Sh1.Cells(Rows.Count, 2).End(xlUp))
　　.Offset(, 1).ClearContents 'C列を消去
　　k = 0
　　For Each n In rng
　　　Set c = .Find(What:=Trim(n.Value), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchByte:=False)
　　　If Not c Is Nothing Then
　　　　If c.Offset(, 1).Value = "" Then
　　　　　Set r = c
　　　　　k = 1
　　　　End If
　　　　FAdd = c.Address
　　　　Do
　　　　　Set c = .FindNext(c)
　　　　　If c.Address = FAdd Then Exit Do
　　　　　If c.Offset(, 1).Value = "" Then
　　　　　　If Not r Is Nothing Then
　　　　　　　Set r = Union(r, c)
　　　　　　Else
　　　　　　　Set r = c
　　　　　　End If
　　　　　　k = k + 1
　　　　　End If
　　　　Loop Until c Is Nothing
　　　　If Not r Is Nothing Then
　　　　　r.Value = n.Offset(, 1).Value
　　　　　r.Offset(, 1).Value = "*"
　　　　　n.Offset(, 2).Value = k
　　　　　k = 0
　　　　End If
　　　　FAdd = ""
　　　　Set r = Nothing
　　　End If
　　Next
　　'.Offset(, 1).ClearContents 'C列の*を消去
　　Application.ScreenUpdating = True
　End With
　Set rng = Nothing
　Set Sh1 = Nothing
　Set Sh2 = Nothing
End Sub

お礼

回答ありがとうございます。
高度すぎて、理解ができていませんが・・・・試してみたいと思います。

やっぱりVBAの勉強が必要だと実感しました・・・