総ありがとう 4,703万
詳細
検索
解決済み

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

  • 困ってます
  • 質問No.9546921
  • 閲覧数107
  • ありがとう数2
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 92% (230/250)

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

「請求書データベース」の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
このユーザに質問する

ベストアンサー率 62% (431/685)

Visual Basic カテゴリマスター
？
>該当する得意先名の入ったセルをすべて選択して、
なぜ選択する必要が？
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
通報する
共感・感謝の気持ちを伝えよう！ ありがとう0 （OK-チップをおくる）
お礼コメント
shibushijuko

お礼率 92% (230/250)

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

助かりました。ありがとうございます。m(_ _)m
投稿日時 - 2018-10-13 09:44:29
たいせつな将来のこと。あえて、知らない人に聞いてみよう。

その他の回答 （全2件）

  • 回答No.3
このユーザに質問する

ベストアンサー率 60% (164/271)

Visual Basic カテゴリマスター
？
おそらくこの種の処理は、
レコードの順処理のほうがわかりやすく、コードも読みやすいと思います。

変更する会社コード：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>
通報する
共感・感謝の気持ちを伝えよう！ ありがとう0 （OK-チップをおくる）
お礼コメント
shibushijuko

お礼率 92% (230/250)

ご回答いただき、誠にありがとうございます。
ユーザーフォームは変更したい行数を入力して、対象となる行の値を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
投稿日時 - 2018-10-13 09:41:27
  • 回答No.2
このユーザに質問する

ベストアンサー率 62% (431/685)

Visual Basic カテゴリマスター
？
訂正です。
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)
通報する
共感・感謝の気持ちを伝えよう！ ありがとう0 （OK-チップをおくる）
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

送 信
関連するQ&A
こんな書き方もあるよ！この情報は知ってる？あなたの知識を教えて！
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
詳細検索

特集

[一覧]


OKWAVE若者応援スペシャル企画

AIがおススメ！知っておきたいQ&A

ピックアップ

カテゴリ

[ 一覧 ]
ページ先頭へ

あなたを助けてくれる人がここにいる あなたも誰かを助けることができる

誰かの疑問に誰かが答えることでQ&A が出来上がり、後で見に来たたくさんの人の悩みの解決に役立てられています。
あなたもQ&A で誰かの悩みに答えてみませんか？ 詳しくはこちら
カテゴリ別にQ&Aを見る
キーワードでQ&A、テーマを検索する
詳細検索
コンテンツ
コンタクト
関連サービス
OKWAVE bestanswer
Copyright © 2019 OKWAVE, Inc. All Rights Reserved.