シート状で同一の値のあるセルを一括変更するには

質問

シート名「マスタ」には会社コード、会社名、住所、電話番号が入っています。このマスターの情報をもとにシート名「請求書入力フォーム」で情報を入れ、その内容がすべて「請求書データベース」に転記されます。

「請求書データベース」のA列は会社コード、B列は注文日付、C列は得意先名、D列以降は注文内容です。

会社名の変更があったとき、「マスタ」のユーザーフォーム上で変更させ、その変更前の値を「請求書データベース」のAT1に変更後の値をAU1に、該当会社コードをAV1に転記するようマクロを作りました。
ここまではうまく動作しているのですが、「請求書データベース」の変更前のセルAT1を使って、該当する得意先名の入ったセルをすべて選択して、その後AU1の変更後の得意先名に書き換えたいのですが、どうすればよいでしょうか。

一応、変更前のAT1の値から、「請求書データベース」のC列の該当する会社名をすべて選択するマクロまでは作りました。下記マクロ文で該当するセルをすべてうまく選択するところまではできています。　よろしくお願いします。
Sub お得意先検索()
Dim fnd As Range
Dim fnd_all As Range ' 見つかったすべてのセル
Dim adr As String ' 最初に見つかったセルのAddress
Dim keyWord As String '検索値をkeyWordに格納

keyWord = Range("AT1").Value

Set fnd = Cells.Find(keyWord)
If fnd Is Nothing Then
MsgBox "見つかりませんでした。"
Exit Sub
Else
Set fnd_all = fnd
adr = fnd.Address
End If

Do
Set fnd = Cells.FindNext(After:=fnd)
If fnd.Address = adr Then
Exit Do
Else
Set fnd_all = Union(fnd_all, fnd)
End If
Loop

fnd_all.Select
End Sub

回答No.1

watabe007 · ベストアンサー

>該当する得意先名の入ったセルをすべて選択して、
なぜ選択する必要が？
Sub お得意先検索()
　　Dim fnd As Range
　　Dim fnd_all As Range
　　Dim adr As String '最初に見つかったセルのAddress
　　Dim keyWord As String '検索値をkeyWordに格納

　　With Worksheets("請求書データベース")
　　　　keyWord = Range("AT1").Value
　　　　Set fnd = .Columns("C").Find(What:=keyWord, LookIn:=xlValues, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False)
　　　　If fnd Is Nothing Then
　　　　　　MsgBox keyWord & " は見つかりませんでした。", 48
　　　　　　Exit Sub
　　　　End If
　　　　Set fnd_all = fnd
　　　　adr = fnd.Address
　　　　Do
　　　　　　Set fnd_all = Union(fnd_all, fnd)
　　　　　　Set fnd = .Columns("C").FindNext(fnd)
　　　　Loop While adr <> fnd.Address
　　　　fnd_all.Value = .Range("AU1").Value
　　End With
End Sub

>その後AU1の変更後の得意先名に書き換えたいのですが
書き換えだけなら置換では
Sub 置換処理()
　　With Worksheets("請求書データベース")
　　　　.Columns("C").Replace What:=.Range("AT1").Value, _
　　　　　　Replacement:=.Range("AU1").Value, _
　　　　　　LookAt:=xlWhole, SearchOrder:=xlByRows, _
　　　　　　MatchCase:=True, MatchByte:=True
　　End With
End Sub

お礼

ご回答いただき、誠にありがとうございます。
すでに出来上がっているマクロの流れから、ご提示いただいた置換処理がまさに希望道理の結果となりました。

助かりました。ありがとうございます。m(_ _)m

回答No.3

HohoPapa

おそらくこの種の処理は、
レコードの順処理のほうがわかりやすく、コードも読みやすいと思います。

変更する会社コード：123
変更前会社名：山田商店
変更後会社名：海畑商店

請求書データベース
会社コード,注文日付、得意先名....
123,2018/2/3,山田商店　　2行目
123,2018/2/4,森林商店　　3行目
456,2018/2/6,山田商店　　4行目
123,2018/2/7,海畑商店　　5行目

上記のデータの時
2行目は修正対象と思いますが
3,4,5行目は対象外にすればいいのか、
何らかの例外処理が必要なのか考える必要があるんじゃないかと思います。

また、修正するためのデータは、
ユーザフォームから取得してもいいんじゃないかと思います。

Sub DB_SH_Ment()

　Dim MentKey As String
　Dim OldName As String
　Dim NewName As String
　Dim RowCounter As Long
　Dim DBSH As Worksheet

　Set DBSH = ThisWorkbook.Sheets("請求書データベース")

　'更新データをシートから取得
　MentKey = DBSH.Cells(1, 48).Value　'AV
　OldName = DBSH.Cells(1, 46).Value　'AT
　NewName = DBSH.Cells(1, 47).Value　'AU
'　'更新データをユーザフォームから取得
'　With UserForm1
'　　MentKey = .TextBox1.Text
'　　OldName = .TextBox2.Text
'　　NewName = .TextBox3.Text
'　End With

　RowCounter = 2
　Do

　　If DBSH.Cells(RowCounter, 1).Value = "" Then Exit Do
　　If ((DBSH.Cells(RowCounter, 1).Value = MentKey) And _
　　　　(DBSH.Cells(RowCounter, 3).Value = OldName)) Then
　　　DBSH.Cells(RowCounter, 3).Value = NewName
　　End If
　　If ((DBSH.Cells(RowCounter, 1).Value = MentKey) And _
　　　　(DBSH.Cells(RowCounter, 3).Value <> OldName)) Then
　　　'何らかの例外処理
　　End If

　　RowCounter = RowCounter + 1
　Loop

End Sub

※動作確認は一切行っていません。　　<m(__)m>

お礼

ご回答いただき、誠にありがとうございます。
ユーザーフォームは変更したい行数を入力して、対象となる行の値をTextBoxに取得させるマクロを最初に実行させるように作りました。
以下がそのマクロ文です。　TextBox1は行番号、TextBox2は会社名、TextBox3以降は会社の住所や電話番号などの情報が入ります。

二つ目のマクロ文は変更前の会社名を同一シート上のZ1、変更後の会社名をZ3に取得させ、それぞれの値を「請求書データベース」AT1及びAT2が参照するようにしています。

理想的にはユーザーフォームから、すべて一括処理させることができればと思っています。ご教授いただいた内容で考えてみたいと思います。

Private Sub CommandButton3_Click()
ActiveSheet.Unprotect
Sheets("マスター").Range("D1").Value = TextBox1.Value
If Range("D1") = "" Then
MsgBox "何も入力されていません。", vbCritical
ActiveSheet.Protect

Else
If IsNumeric(Range("D1").Value) = True Then

ActiveSheet.Unprotect
Dim i As Integer
i = TextBox1.Value
TextBox2.Value = Cells(i, 1)
TextBox3.Value = Cells(i, 2)
TextBox4.Value = Cells(i, 3)
TextBox5.Value = Cells(i, 4)
TextBox6.Value = Cells(i, 6)
Range("Z2").Value = TextBox2.Value
Range("Z3").Value = TextBox3.Value
ActiveSheet.Protect
MsgBox Range("D1") & "行目を表示しました。" & vbCrLf & "変更後(2)登録・変更ボタンを押してください。"
ActiveSheet.Protect

Else
MsgBox "数値のみ入力してください。", vbCritical
ActiveSheet.Protect
End If
End If

End Sub

Private Sub CommandButton3_Click()
ActiveSheet.Unprotect
Sheets("マスター").Range("D1").Value = TextBox1.Value
If Range("D1") = "" Then
MsgBox "何も入力されていません。", vbCritical
ActiveSheet.Protect

Else
If IsNumeric(Range("D1").Value) = True Then

ActiveSheet.Unprotect
Dim i As Integer
i = TextBox1.Value
TextBox2.Value = Cells(i, 1)
TextBox3.Value = Cells(i, 2)
TextBox4.Value = Cells(i, 3)
TextBox5.Value = Cells(i, 4)
TextBox6.Value = Cells(i, 6)
Range("Z2").Value = TextBox2.Value
Range("Z3").Value = TextBox3.Value
ActiveSheet.Protect
MsgBox Range("D1") & "行目を表示しました。" & vbCrLf & "変更後(2)登録・変更ボタンを押してください。"
ActiveSheet.Protect

Else
MsgBox "数値のみ入力してください。", vbCritical
ActiveSheet.Protect
End If
End If

End Sub

回答No.2

watabe007

訂正です。
Set fnd = .Columns("C").Find(What:=keyWord, LookIn:=xlValues, _
　　LookAt:=xlPart, SearchOrder:=xlByRows, MatchByte:=False)
　　　　　　　↓xlPart⇒xlWhole　　　　　　　　　　　　↓False⇒True
Set fnd = .Columns("C").Find(What:=keyWord, LookIn:=xlValues, _
　　LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=True)