解決済み

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

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

お礼率 91% (218/237)

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

「請求書データベース」の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

ベストアンサー率 61% (359/586)

>該当する得意先名の入ったセルをすべて選択して、
なぜ選択する必要が?
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
お礼コメント
shibushijuko

お礼率 91% (218/237)

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

助かりました。ありがとうございます。m(_ _)m
投稿日時 - 2018-10-13 09:44:29
感謝経済、優待交換9月20日スタート

その他の回答 (全2件)

  • 回答No.3

ベストアンサー率 64% (132/205)

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>
お礼コメント
shibushijuko

お礼率 91% (218/237)

ご回答いただき、誠にありがとうございます。
ユーザーフォームは変更したい行数を入力して、対象となる行の値を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

ベストアンサー率 61% (359/586)

訂正です。
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)
AIエージェント「あい」

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

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

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

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

特集


より良い社会へ。感謝経済プロジェクト始動

ピックアップ

ページ先頭へ