複数ファイル内への文字置き換え

投稿者 : noviceAAA     投稿日時 : 2025/02/14(Fri) 12:17:22     OS : Windows 10     EXCEL : Excel 2013

---

始めてこちらを使用させていただきます。
VBAは、全くの初心者です。
お伝えする内容に不備が多いかと思いますが、よろしくお願いいたします。

行いたい内容は、ファイルAに変更したいリストがあります。
以下、ファイルAです。A列1行目が【名前】、B列1行目が【変更前】、C列1行目が【変更後】です。※名前は数百件ございます。


名前 変更前 　　変更後
新井 営業 　　製造
荒木 製造 　　品質管理
飯田 品質管理　　製造
飯塚 品質管理　　開発
上田 経理 　　総務


置き換えを行いたいファイルは、同書式で数百件。
A列5行目が【Lv】、B列1行名が【NO.】、C列1行目が【名前】、D列1行目が【部署】です。
上記、変更リストの名前が一致すれば、部署名を変更後のものに置き換えて欲しいです。


Lv NO. 名前 部署
1 001 新井 営業
1 008 飯田 品質管理
1 009 上田 経理


ご教授いただければ幸いです。
よろしくお願いいたします。

投稿者 : さんこう     投稿日時 : 2025/02/14(Fri) 16:05:29

---

＞置き換えを行いたいファイルは、同書式で数百件。

どこにあるのか不明なので、１件だけのサンプルです。

参考になれば。

Sub Test()
    Set lws = ActiveSheet
    
    f = Application.GetOpenFilename("Excel,*.xls?")
    
    If f <> "False" Then
        Set wb = Workbooks.Open(f)
        
        For i = 6 To Cells(Rows.Count, "A").End(xlUp).Row
            n = Cells(i, "C")
            If WorksheetFunction.CountIf(lws.Columns("A"), n) Then
                Cells(i, "D") = WorksheetFunction.VLookup(n, lws.Columns("A:C"), 3, 0)
            End If
        Next
        '保存して閉じる
    End If
    
End Sub

投稿者 : ピロリ     投稿日時 : 2025/02/15(Sat) 12:00:07

---

■[質問] noviceAAAさん（2025-02-14 12:17:22）の記事
＞ 行いたい内容は、ファイルAに変更したいリストがあります。
「ファイルA.xslm」ブックの「変更リスト」シートに変更部署の記載が有って、
＞ 置き換えを行いたいファイルは、同書式で数百件。
「ファイルB.xlsx」ブックの「社員リスト」シートの部署名を置き換えるものとし、両ブックともに
開いている前提でのサンプルコードを載せておきます。
要は、複数のブックやシートを扱う場合、ブックやシートを取り違えないように注意ってことです。

Findメソッドで名前検索してますが処理は遅いので、処理速度が気になるようなら、Match関数とか、
[返信 1] さんこうさん案の VLookup関数で検索すると良いでしょう。
また「社員リスト」に同じ名前が複数存在すること（同姓同名の社員の入社とか）を考慮するなら、
名前ではなく社員番号などのユニークなコードで検索する方が良いと思います。
老婆心ながら･･･

Sub Sample()
    Dim BkA As Workbook, ShA As Worksheet
    Dim BkB As Workbook, ShB As Worksheet
    Dim Nam As String, Hit As Range
    Dim i As Long
    
    Set BkA = Workbooks("ファイルA.xlsm")   '変更リストが有るファイルAを指定
    'Set BkA = ThisWorkbook                 'このマクロがファイルAに記述されてるなら、こちらでも。
    Set ShA = BkA.Worksheets("変更リスト")  '変更リストのシートを指定
    
    Set BkB = Workbooks("ファイルB.xlsx")   '書換えたい部署名が有るファイルBを指定
    Set ShB = BkB.Worksheets("社員リスト")  '部署名を書換えたいシートを指定
    'Set ShB = BkB.Worksheets(1)            'ファイルBが 1シートしかないのなら、こちらでも･･･
    'Set ShB = BkB.ActiveSheet              '　あるいは、こちらでも良いでしょう。
    
    For i = 2 To ShA.Cells(Rows.Count, "A").End(xlUp).Row           '変更リストの行数分ループ
        Nam = ShA.Cells(i, "A")                                     '名前を取得して、
        Set Hit = ShB.Range("C:C").Find(What:=Nam, LookAt:=xlWhole) 'ファイルBのC列を名前検索
        If Not Hit Is Nothing Then                                  '名前が見付かったら、
            Hit.Offset(0, 1) = ShA.Cells(i, "C")                    '名前の右側の部署名を変更
        End If
    Next i
End Sub

投稿者 : noviceAAA     投稿日時 : 2025/02/20(Thu) 15:53:21

---

返事が遅くなって申し訳ありません。

さんこう 様
ファイル名も場所の説明もなく、申し訳ございません。
こちらでファイル名等を修正して、動かすことができました。
ありがとうございます。


ピロリ 様
詳しくご説明いただきありがとうございます。
動かしながら確認して転機作業可能となりました。

他のデータへも一部加えて使用させていただきます。

本当にありがとうございました。