Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
一致する行の検索
投稿日時: 21/05/30 14:53:11
投稿者: sue619

お世話になります。
シート1に、A列にデータNO、B列に内容の一覧があります。
シート2に,複数の修正したいNOと内容を入力し、マクロを実行すると、シート1の該当するNOの内容が
上書きさせるにはどうすればいいでしょうか?
 
シート2のNOと、シート1のNOが一致する行を検索、シート2の内容をコピーして、
シート1の検索した行に一致する内容を、シート2の内容に貼り付けする。
シート2に入力されたデータ件数分、データの上書きを繰り返す。
といったイメージです。 よろしくお願いいたします。
 
シート2
   列A   列B
行  NO    内容
1   15     AAA
2   11     BBB
3   10     CCC
 
 
シート1
    列A     列B
行   NO     内容       
1   10      AAA   →  CCC
2   15      CCC  → AAA
3   3      AAA
4   20     BBB
5   11      DDD   → BBB
 

回答
投稿日時: 21/05/30 15:44:28
投稿者: WinArrow
投稿者のウェブサイトに移動

コードの作成依頼は、禁止されているので、
 
ヒントとして手順を紹介します。
 
1件だけの手順です。
(1)シート2のNOを検索キーとしてシート1を検索します。
 手操作でしたら、「検索コマンド」を使うことになります。
(2)シート1が検索できたら、シート2の内容をコピー&ペーストします。
  これも手操作で可能ですよね?
 
以上が1件だけの処理です。
 
各々は、単体では、マクロの記録でコードを作成することができます。
 
次にシート2のデータ件数だけ、上の1件だけの処理を繰り返すことになります。
 
そこで、1件だけの処理で、作成したコードでは、セルアドレスが固定になっています。
この固定となっているところを可変に変更します。
つまりセルアドレスを変数に置き換えるわけです。
 
これができたら、繰り返し処理を作成することになるが、この部分は、マクロの記録では対応
できません。
 
取り敢えず、1件だけの処理のコードを作成してみませんか?
その後で、繰り返し部分のアドバイスをもらうようにしましょう。
 
 
 
 

投稿日時: 21/05/30 16:50:11
投稿者: sue619

WinArrow 様
 お世話になります。
 返信ありがとうございます。
 利用上の注意事項を知らず、コード作成依頼をしてました。
 それでは、以下のコードについて、修正箇所のご教示は可能でしょうか。
 
  以下では、検索した結果の行にデータが貼り付けされてしまいます。
 入力したセルの数値と一致する行にデータを張るには、どのように修正すればいいでしょうか。
 
    'データ件数を確認
        lastRow = Sheet2.Range("A1").End(xlDown).Row
 
        '繰り返し回数の初期設定
        N = 2
 
        If lastRow = 2 Then
    
    ’検索範囲を指定して、結果をADに格納    
    検索 = Sheet2.Cells(N, "A").Value
        Set AD = Sheet1.Range("A1:A10").Find(What:=検索, LookAt:=xlWhole)
 
        ’格納したADをシート1に貼り付け
    Sheet2.Cells(N, "A").Select
        Sheet2.Cells(N, "B").Resize(1, 1).Copy
        Sheet1.Cells(AD + 1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False
   
   ’繰り返し処理
       ElseIf lastRow >= 3 Then
       For N = 2 To lastRow
 
       検索 = Sheet2.Cells(N, "A").Value
        Set AD = Sheet1.Range("A1:A150000").Find(What:=検索, LookAt:=xlWhole)
        Sheet2.Cells(N, "A").Select
        Sheet2.Cells(N, "B").Resize(1, 1).Copy
        Sheet1.Cells(AD + 1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False
        Next
 
 
    よろしくお願いいたします。
 
 
 

回答
投稿日時: 21/05/30 17:36:29
投稿者: WinArrow
投稿者のウェブサイトに移動

いくつkの問題点gあります。
  
まず、最初に変数名の定義をしてください。
  
シート2のデータが1件しかない場合と2件以上と分けてあります。
違いはシート1の検索範囲だけです。
敢えて、わける必要があるのでしょうか?
問題は、↓
変数」ADは、Rangeオブジェクトになりますから
Cells(AD,"A")のように「行」として使用することはできません。
Cells(AD.Row, "A")のようにRowプロパティを付ければOKです。
  
質問
なぜ、AD+1 なんでしょうか?
  
 
 

引用:

    Sheet2.Cells(N, "A").Select
        Sheet2.Cells(N, "B").Resize(1, 1).Copy

↑のコードですが、
セルをSelectしていますが、この時、シート2がアクティブである必要があります。
  
    Sheet2.Cells(N, "A").Offset(,1).Copy
または、
    Sheet2.Cells(N, "B").Copy

と記述すれば、シートをアクティブにする必要はありません。
シートやセルをSelectすることはレスオンスに影響するので、使わない方がよいです。
この場合、Resize(1, 1)は不要です。

回答
投稿日時: 21/05/31 07:26:27
投稿者: WinArrow
投稿者のウェブサイトに移動

問題個所
 

引用:

       Sheet1.Cells(AD + 1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False

↑貼付け場所が,A列セルになっていますが、
B列セルの間違いでは?
 
↓修正案
       Sheet1.Cells(AD.Row, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False

投稿日時: 21/05/31 17:54:01
投稿者: sue619

 お世話になります。
 ご返信ありがとうございます。
 
 ・変数定義は記載漏れでした。
 ・データ件数の判定ですが、空白になるまで実行するでもよかったかと思います。今思えば・・
 ・Rowプロパティでやってみます。
 ・AD+1 ですが、タイトル行分を足さないと、上書きされる行がづれたため付けてました。
   Cells(AD.Row, "A")で検証したいと思います。
 ・Sheet2.Cells(N, "A").Offset(,1).Copyに変更します。処理軽減策ありがとうございます。
 ・貼り付け場所の記述が間違ってました。Bが正しいです。
 
 上記内容にて修正を行い検証したいと思います。
 ご教示を頂きありがとうございました。