Excel VBAで会員データをある条件で振り分けたい

大変困っているので助けてください。

Ａ列に「会員番号」、Ｂ列に「名前」、Ｃ列に「住所」・・・と言った感じのデータがあります。

Input BoxまたはUser Formを使って会員番号を入力し、該当したときにその隣（例えばＤ列）に「１」などの値を入力できる方法。
または、上記のデータと別のデータ（項目は同じ）を照合し一致しない物を別のシートに表示するという形でもいいです。
仕事で早急に必要なのですが、ＶＢＡの知識があまり無いのでいろいろ試行錯誤しましたができません。
お願いします。

No.2 ベストアンサー 回答者： merlionXX 回答日時： 2005/09/06 14:12

> Ａ列に「会員番号」、Ｂ列に「名前」、Ｃ列に「住所」・・・と言った感じのデータがあります。

これをSheet1とします。

> 上記のデータと別のデータ（項目は同じ）

これをSheet2とします。

> 一致しない物を別のシートに表示

これをSheet3とします。

Sheet1にあってSheet2に存在しない会員番号のA～C列をSheet3に表示するVBAです。

Sub test()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")

For i = 1 To sh1.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Set x = sh2.Columns("A").Find(What:=sh1.Cells(i, "A"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If x Is Nothing Then
r = r + 1
For n = 1 To 3
sh3.Cells(r, n) = sh1.Cells(i, "A").Offset(0, n - 1).Value
Next n
End If
Next i
End Sub

Sheet2にあってSheet1にないデータもちょっと応用すればこれで出来ますよね？

この回答へのお礼

ありがとうございます。
思っていた以上にスムーズに処理ができました。

お礼日時：2005/09/08 01:34

No.3 回答者： KenKen_SP 回答日時： 2005/09/06 19:08

こんにちは。

KenKen_SP です。

> Input BoxまたはUser Formを使って会員番号を入力し、該当したときにその隣
>（例えばＤ列）に「１」などの値を入力できる方法。

ご参考までに。

'// InputBox で会員番号を入力し、該当セルの行D列に1を書き込む
Sub Sample1()

　　Dim strCode As String
　　Dim rngSA　 As Range
　　Dim rngFC　 As Range
　　Dim Sh　　　As Worksheet
　　
　　'検索するシートを定義
　　Set Sh = ThisWorkbook.Sheets("Sheet1")
　　　　
　　'検索する受付番号を取得
　　'0で始まる文字列の数字があるかも知れないので文字列型変数で受ける
　　strCode = Application.InputBox("会員番号を入力", Type:=2)
　　'キャンセルボタンクリックなら終了
　　If UCase$(strCode) = "FALSE" Then Exit Sub

　　'会員番号の検索範囲を取得
　　'Sheet1の使われている範囲とA列の交差範囲＝検索範囲
　　Set rngSA = Intersect(Sh.UsedRange, Sh.Range("A:A"))
　　'検索範囲から入力された会員番号を探す
　　Set rngFC = rngSA.Find(What:=strCode, LookAt:=xlWhole)
　　
　　If rngFC Is Nothing Then
　　　　'該当番号が無ければ警告を表示
　　　　MsgBox "該当する会員番号はありません！", vbCritical, "エラー"
　　Else
　　　　'該当番号があれば変数 rngFC には見つかったセルがセットされている
　　　　'そのセル(A列）からOffset(行,列）で3つ横＝D列のセルに1を書き込み
　　　　'移動する
　　　　rngFC.Offset(0, 3).Value = 1
　　　　Application.Goto Reference:=rngFC
　　End If

　　'変数をクリア（オブジェクト変数はできるだけ明示的にクリアして下さい）
　　Set rngFC = Nothing
　　Set rngSA = Nothing
　　Set Sh = Nothing

End Sub

この回答へのお礼

非常に参考になりました。
説明付きでわかりやすかったです。

お礼日時：2005/09/08 01:35

No.1 回答者： imogasi 回答日時： 2005/09/06 14:12

標準モジュールに

Sub test01()
d = Range("A65536").End(xlUp).Row
'---
Do
n = InputBox("会員番号＝")
If n = "99999" Then Exit Sub '終わり
fnd = "n"
For i = 1 To d
If Cells(i, "A") = Val(n) Then
Cells(i, "D") = 1
fnd = "y"
End If
Next i
If fnd <> "y" Then
MsgBox n & "は見つかりません"
End If
Loop
End Sub
一番初歩的なロジックで。
データ数が多く、反応がいらいらするぐらい遅い場合は、他の方法を使ってください。

この回答へのお礼

ありがとうございます。
初心者の私にはわかりやすい内容でした。
が、imogasiさんの言うとおり「反応が遅い」と言うより、
フリーズしてしまいました・・・
せっかく教えていただいたのにスミマセン。

お礼日時：2005/09/08 01:32