総ありがとう数 累計4,263万(2014年9月30日現在)

毎月4,000万人が利用!Q&Aでみんなで助け合い!

-PR-
pattern706

エクセルのVBAを使ってデータ検索を行うプログラムを作っています

"Sheet2"は下記のように、A列に生年月日、B列に住所、C列に電話番号、D列にメールアドレスが入力されています

       【Sheet2】
  生年月日  住所    電話番号  メールアドレス
    A      B       C        D
1 1999/9/10 東京都○○ 11-111-1111 aa@goo.co.jp
2 2003/2/26 大阪府○○ 22-222-2222 bb@goo.co.jp
3 1985/6/22 福岡県○○ 33-333-3333 cc@goo.co.jp
4 1995/4/11 愛知県○○ 44-444-4444 dd@goo.co.jp


"Sheet1"のA1に生年月日、A2に住所、A3に電話番号を入力し、"Sheet2"のデータと照合して、3つの値が合致した行のD列のメールアドレスを"Sheet1"のB1に返したいと思います

上記の表だと、"Sheet1"のA1に1985/6/22、A2に福岡県○○、A3に33-333-3333と入力されている場合、B1にcc@goo.co.jpの値を返すようにしたいのです。

findを使って生年月日、住所、電話番号を検索し、行番号を取得して、3つの行番号が同じならその行番号のD列の値を返すというような方法で考えていたのですが、エラーが回避できずに困っています。
生年月日が同じ人がいたり、夫婦や親子などは住所と電話番号が同じといった場合があり、上手く検索できません。 

エラー回避の方法、もしくは他のやり方でも構いませんので
どなたかご教授願えないでしょうか?
よろしくお願いします。
  • 回答数6
  • 気になる数2

Aみんなの回答(全6件)

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

  • 2008-09-21 22:18:14
  • 回答No.3
ANo.2です。
すみません。ミスがありました。
Sub test()

Dim sh1 As Object, sh2 As Object
Dim d1 As String, d2 As String, r As Long

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

r = 1
d1 = sh1.Cells(1, 1) & sh1.Cells(2, 1) & sh1.Cells(3, 1)
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
Do While d2 <> ""
If d1 = d2 Then
sh1.Cells(1, 2) = sh2.Cells(r, 4)
Exit Do
End If
r = r + 1
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
Loop

End Sub
お礼コメント
お礼が遅れて申し訳ありませんでした。
無事にプログラム作成できました
本当に助かりました
ありがとうございました
投稿日時 - 2008-09-25 21:00:56
  • 同意数0(0-0)
  • ありがとう数0

その他の回答 (全5件)

  • 2008-09-24 00:49:12
  • 回答No.6
なんどもすみません。

d1 = Sheets("Sheet1").Cells(1, 1).value
d2 = Sheets("Sheet1").Cells(2, 1).value
d3 = Sheets("Sheet1").Cells(3, 1).value

上のところが間違いですので、差し替えて
お礼コメント
お礼が遅れて申し訳ありませんでした。
他の回答者の方の方法でプログラムを作成しましたが
こちらの方法も試してみます
ありがとうございました
投稿日時 - 2008-09-25 20:59:55
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 2008-09-24 00:30:02
  • 回答No.4
Sheets("Sheet1").Cells(,) では、スピードがめちゃ遅いので、多いデータだと
全くつかいものになりません。

やはり、FINDでするべきです。

Dim a As Range
Dim b As Range
Dim c As Range

Dim ar As Long
Dim br As Long
Dim cr As Long

Dim d1 As string
Dim d2 As string
Dim d3 As string

l = 1

d1 = Sheets("Sheet1").Cells(1, 1).value
d2 = Sheets("Sheet1").Cells(1, 1).value
d3 = Sheets("Sheet1").Cells(1, 1).value

l = 1
Do
Set a = Sheets("Sheet2").Range("A" & l & ":A1000").Find(d1, , , xlWhole)
Set b = Sheets("Sheet2").Range("B" & l & ":A1000").Find(d2, , , xlWhole)
Set c = Sheets("Sheet2").Range("C" & l & ":A1000").Find(d3, , , xlWhole)

l = 65000
If a Is Nothing = True And b Is Nothing = True And c Is Nothing Then Exit Do (みつからない)

If a Is Nothing = False Then ar = a.Row Else ar = l
If b Is Nothing = False Then br = b.Row Else br = l
If c Is Nothing = False Then cr = c.Row Else cr = l

If ar = br And ar = cr Then Exit Do <======= 3列の行同じ(ここでみつかっている)

If l > ar Then e = ar
If l > br Then e = br
If l > cr Then e = cr

Loop

上のでほぼいくのでは?。デバッグはしていないが。そちらでデバッグして下さい。

注意点は下記の通りです。

1行目は空けて、2行目からデータが入っているとのこと。
また。 l = 1 は開始の行ですが、ここは1でよい。

Set a = Sheets("Sheet2").Range("A" & l & ":A1000").Find(d1, , , xlWhole)

  Range("A" & l & ":A1000") で指定する最終行は、最終行の値+1になっています。

 すなわち、上のソースでは、2行目から999行目までデータがあるとのことになります。
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 2008-09-24 00:42:20
  • 回答No.5
#4の回答者です。
下記のロジックのが早く検索できます。

Dim a As Range
Dim b As Range
Dim c As Range

Dim ar As Long
Dim br As Long
Dim cr As Long

Dim d1 As string
Dim d2 As string
Dim d3 As string

l = 1

d1 = Sheets("Sheet1").Cells(1, 1).value
d2 = Sheets("Sheet1").Cells(1, 1).value
d3 = Sheets("Sheet1").Cells(1, 1).value

l = 1
Do
Set a = Sheets("Sheet2").Range("A" & l & ":A1000").Find(d1, , , xlWhole)
Set b = Sheets("Sheet2").Range("B" & l & ":A1000").Find(d2, , , xlWhole)
Set c = Sheets("Sheet2").Range("C" & l & ":A1000").Find(d3, , , xlWhole)

If a Is Nothing = True And b Is Nothing = True And c Is Nothing Then Exit Do (みつからない)

If a Is Nothing = False Then ar = a.Row Else ar = 1000
If b Is Nothing = False Then br = b.Row Else br = 1000
If c Is Nothing = False Then cr = c.Row Else cr = 1000

If ar = br And ar = cr Then Exit Do <======= 3列の行同じ(ここでみつかっている)

If l < ar Then l = ar     ここを変えた。
If l < br Then l = br
If l < cr Then l = cr

Loop
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 2008-09-21 21:04:00
  • 回答No.1
Sub Sample()

Dim Data As Range
Dim i As Long

Set Data = Sheets("Sheet2").Range("a1").CurrentRegion

With Sheets("Sheet1")
For i = 1 To Data.Rows.Count
If .Range("a1") = Data.Cells(i, 1) And _
.Range("a2") = Data.Cells(i, 2) And _
.Range("a3") = Data.Cells(i, 3) Then
.Range("b1") = Data.Cells(i, 4)
Exit For
End If
Next i
End With

End Sub

でどうでしょう。
お礼コメント
お礼が遅れて申し訳ありませんでした。
大変参考になりました
ありがとうございました
投稿日時 - 2008-09-25 21:01:47
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 2008-09-21 22:13:40
  • 回答No.2
Sub test()

Dim sh1 As Object, sh2 As Object
Dim d1 As String, d2 As String, r As Long

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

d1 = sh1.Cells(1, 1) & sh1.Cells(2, 1) & sh1.Cells(3, 1)

r = 1
Do While d1 <> ""
d2 = sh2.Cells(r, 1) & sh2.Cells(r, 2) & sh2.Cells(r, 3)
If d1 = d2 Then
sh1.Cells(1, 2) = sh2.Cells(r, 4)
Exit Do
End If
r = r + 1
Loop

End Sub
通報する
  • 同意数0(0-0)
  • ありがとう数0
  • 回答数6
  • 気になる数2
  • ありがとう数2
  • ありがとう
  • なるほど、役に立ったなど
    感じた思いを「ありがとう」で
    伝えてください

関連するQ&A

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

別のキーワードで再検索する

あなたの悩みをみんなに解決してもらいましょう

  • 質問する
  • 知りたいこと、悩んでいることを
    投稿してみましょう
-PR-
-PR-
-PR-

特集

正しい方法で健康的な綺麗を手に入れよう!

お城、ボート、ツリーハウス、ユニークな物件満載!

親同士が気軽に情報交換できるコミュニティです。

関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ