こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel VBA ある範囲内で検索条件に一致したデータを入力する

Excel VBA ある範囲内で検索条件に一致したデータを入力する

Excel2003を使用しています。
Sheet2で選択している範囲内のB列のデータがSheet1で選択している範囲内のB列のデータと一致していたら、そのA列のデータをSheet2のA列に入力するというマクロを作成中ですが、うまくいきません…。
Sheet1とSheet2の選択範囲については、このマクロを実行前に都度選択するようにし、A列のデータは日付、B列のデータは数値です。

以前、示していただいたサンプルを参考にコードを書き換えて試していますが、なかなか思うようにいかず、質問させていただきました。
よろしくお願いします。

投稿日時 - 2010-01-28 17:25:29

QNo.5630401

すぐに回答ほしいです

質問者が選んだベストアンサー

空欄を回避するシステムが仇になってますね。
乗りかかった船なので、これでどうでしょう?

Sub all_check()
  Dim i As Integer, j As Integer
  For i = 0 To Sheets(1).Range("B65536").End(xlUp).Row - 1
    For j = 0 To Sheets(2).Range("B65536").End(xlUp).Row - 1
      If Sheets(1).Range("B1").Offset(i) = _
          Sheets(2).Range("B1").Offset(j) Then
        Sheets(2).Range("A1").Offset(j) = Sheets(1).Range("A1").Offset(i)
      End If
    Next j
  next i
End Sub

投稿日時 - 2010-01-29 18:38:53

お礼

zen_kuukai さま、お礼が遅くなり申し訳ありません。
教えていただいたコードを参考にさせていただき、無事完成しました!
最後までお付き合いくださいまして、ありがとうございました。

投稿日時 - 2010-02-01 10:49:58

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(5)

ああ、動いて一安心です。

>ひとつ確認というか質問ですが、このコードは選択範囲内の1番上の行は、
>それぞれのSheetの1行目(行番号1)ということですよね。

その通りです。まず、

  Do While Sheets(1).Range("B1").Offset(i) <> 0
    i = i + 1
  Loop

で、第1シートのB1から1つずつチェックしながらOffset(i)で下に移動します。
これでセルが「""」つまりなにも入力されていなければ止まります。
(よって、B1になにも入力されていなければ動きません)

こんどは上記のLoop文の中に

    For j = 0 To Sheets(2).Range("B65536").End(xlUp).Row - 1
        If Sheets(2).Range("B1").Offset(j) = "" Then Exit Do
    Next j

のFor文で第2シートのB1から下に検索していきます。
これもセルが「""」(なにも入力されていない)なら止まります。

で、第1シートのB行のあるセルと第2シートのB行のあるセルが同じだったら
第1シートのB行の左隣(つまりA)のセルの値を第2シートの左隣に書き出してね。

という動きです。

なので、「Sheets(1).Range("B1")」をすべて第1シートの最初のB行セル
でもって、「Sheets(2).Range("B1")」をすべて第2シートの最初のB行セル
と書き換えれば(例: 第1シートのB4が最初ならSheets(1).Range("B4"))

動くはず。たぶん。

投稿日時 - 2010-01-29 15:22:21

お礼

zen_kuukai さま、何度もありがとうございます。

手直ししてくださったコードの私なりの解釈が間違っていなかったようで良かったです。
実際に使用するデータで、使えるコードになるよう、選択範囲の最上行を取得して実行してみたところ、希望通り動作しました。

選択範囲のパターンをいくつか試していたら、Sheet1で範囲を選択する際、B列に空欄が含まれる場合があることがあり(ページをまたがっているときなのですが)、Sheet1の選択範囲の最下行も取得して、下記のようにしてみましたが、うまくいきません。

Do While Sheets(1).Cells(r1, 2).Offset(i) <> Sheets(1).Cells(r2, 2)
(r1は選択範囲の最上行、r2は選択範囲の最下行です)

何度も恐れ入りますが、ここがクリアできれば完成しそうなので、もう少しお付き合い願えないでしょうか?
よろしくお願いします。

投稿日時 - 2010-01-29 17:24:26

すみません。
親切で入れたつもりのExitが間違った動きをしていました。
これで動くと思われます。というか、動きました。


Sub all_check()
  Dim i As Integer, j As Integer
  Do While Sheets(1).Range("B1").Offset(i) <> 0
    For j = 0 To Sheets(2).Range("B65536").End(xlUp).Row - 1
      If Sheets(1).Range("B1").Offset(i) = _
          Sheets(2).Range("B1").Offset(j) Then
        If Sheets(2).Range("B1").Offset(j) = "" Then Exit Do
        Sheets(2).Range("A1").Offset(j) = Sheets(1).Range("A1").Offset(i)
      End If
    Next j
    i = i + 1
  Loop
End Sub


混乱させてしまい申し訳ない。

投稿日時 - 2010-01-29 11:35:23

お礼

zen_kuukai さま、再度の回答ありがとうございます。

早速、試してみたところ、無事動作しました。
ひとつ確認というか質問ですが、このコードは選択範囲内の1番上の行は、それぞれのSheetの1行目(行番号1)ということですよね。
実際に使用するデータで実行してみたときは、前回と同じく何も変化が起きなかったのですが、Sheet1とSheet2の選択範囲の最上行を1行目に合わせて実行してみると、希望通りの結果となりました。

今回の質問では、Sheet1、Sheet2ともに、選択範囲の最上行も最下行もバラバラですので、教えていただいたコードを参考にさせていただきながら、少し手を加えてみたいと思います。

投稿日時 - 2010-01-29 14:12:25

すでに回答がついていますが、
こうじゃないかなあと思ったので

Sub all_check()
  Dim i As Integer, j As Integer
  Do While Sheets(1).Range("B1").Offset(i) <> 0
    For j = 0 To Sheets(2).Range("B1").End(xlDown).Row - 1
      If Sheets(1).Range("B1").Offset(i) = Sheets(2).Range("B1").Offset(j) Then
        if sheets(2).Range("A1").Offset(j) then Exit For
        Sheets(2).Range("A1").Offset(j) = Sheets(1).Range("A1").Offset(i)
      End If
    Next j
    i = i + 1
  Loop
End Sub

ただsheet1のB列に同じ数字が2個以上あると
一番下に出たA列の数字しか反映しませんが。
1番目の回答の方で十分でしたら読み飛ばしてください。

投稿日時 - 2010-01-28 19:59:15

お礼

zen_kuukai さま、回答ありがとうございます。

教えていただいたコードで試してみましたところ、エラーメッセージ等は表示されないものの、何も変化が起きませんでした。

>ただsheet1のB列に同じ数字が2個以上あると
>一番下に出たA列の数字しか反映しませんが。

これ(上矢印)に関しては、Sheet1の選択範囲内でB列に同じ数字が2個以上あることはないので、全く問題なかったのですが…。

記載していただいたコードでテスト後、投稿してくださったようですが、もしよろしければ、Sheet1とSheet2の範囲選択をどのようにされていたかを教えていただけないでしょうか?
エラーメッセージでも表示されれば、何かしらのヒントを得られそうなのですが、マクロを実行しても何も変化が起きないので、早速行き詰っています。

投稿日時 - 2010-01-29 11:09:33

ANo.1

前のサンプルがどういったものか分からないので、ごく平凡に。
但し、データ範囲および比較するセルの行番は、sheet1、sheet2 共に同じ1~15行であるとします。

Sub test()
 Dim r As Integer, c As Integer
 Dim n As Integer, n1 As Integer, n2 As Integer

 Sheets("sheet2").Select
 c = 2
 For n = 1 To 15
  r = n
  n2 = Cells(r, c).Value
  n1 = Sheets(1).Cells(r, c).Value
  If n2 = n1 Then
   Cells(r, c-1).Value = Sheets("sheet1").Cells(r, c - 1).Value
  End If
 Next
End Sub

で、試してみてください。

For … Next 文で、変数に n を設定し、行番 r を定義しているのは、シート1,2の各選択範囲が違ったときに、ここでそれぞれの行番を定義すれば (cf. r1 = n + 1、r2 = n + 5 のように) よいので、拡張用にと思ってこの様にしました。

投稿日時 - 2010-01-28 18:23:08

お礼

Yosha さま、回答ありがとうございます。

Sheet1、Sheet2ともに選択範囲(行番号)が同じである場合のコードを教えていただきましたが、今回の質問に関しては、行番号が同じになることはほぼありませんので、回答文の最後に記載されている応用方法で試してみたいと思います。

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

投稿日時 - 2010-01-29 10:57:07

あなたにオススメの質問