プロが教える店舗&オフィスのセキュリティ対策術

こちらで初めて質問します。
VBAはネット上で検索して、少しだけ自分のしたいことに直せるくらいの初心者です。
今、イベントを開催した時に来場いただいた方のデーターベースを作っています。
ネットで検索しながら自分で考えていたことがおおよそ出来上がりつつありますが、
どうしても自分のレベルでは分らないことがあり質問させていただきました。

Sheet1のB2に第〇回の回次の値があり、5行目から下行にデータが入り、
B列に名前、C列にフリガナと続きO列までデータがあります。
Sheet2も5行目から下行にでーたが入り、B列に名前、C列にフリガナと続き
I列からAL列(第1回~第30回)までの列を使用できるようにしています。

やりたい事は、Sheet1、B列の名前でSheet2のB列の名前を検索し、
同じ名前があったら、Sheet1のB2、回次の値を参照して、Sheet2のI列からAL列(第1回~第30回)と名前の交差するセルに●印を入れたいと思っていますがどうしてもできません。
Sheet1に来場者入力完了後まとめて処理をしたいです。
10日ほど格闘していますが、65歳の古ぼけた頭では解決できず、皆様のお知恵をお借りしたいと思います。

(例)第5回(Sheet1,B2の値が5)のイベントに田中正雄さんという方がお見えになったとしたら、Sheet1の田中正雄さんの名前でSheet2を検索し、同じ名前があったら同じ行のM列(第5回)のセルに
●印を記入する。

尚、Excelのバージョンは2010でSheet1・2ともに最終行は不定です。


どうぞよろしくお願いいたします。

質問者からの補足コメント

  • tatsu99さん、ありがとうございます。
    Sheet1のデータは500件ほど、
    Sheet2のデータは最終的には6000~7000件位になると思います。
    回数を重ねるともっと増えることも考えられます。
    どちらのシートも名前の重複はありません。
    以上よろしくお願いします。

    No.2の回答に寄せられた補足コメントです。 補足日時:2016/11/16 23:48
  • tom04 様
    ありがとうございます。
    力不足で申し訳ありません、多分このことでかな~と思いますが

    >尚、↓の画像の薄い黄色のセル(第〇回のセル)は両シートともセルの表示形式を
    ユーザー定義から
    第0回
    としておき、入力は数値のみの入力とします。

    の意味が理解できず、標準モジュールに修正していただいた2回目分を貼り付けますが、
    動作しません。

    No.5の回答に寄せられた補足コメントです。 補足日時:2016/11/18 05:12

A 回答 (6件)

No1です。


以下のマクロを標準モジュールへ登録してください。
実行結果は、添付の図のようになります。
------------------------------------------------------------
Option Explicit


Public Sub 出席者記入()
Dim Sh1, Sh2 As Worksheet
Dim MaxRow1 As Long ' Sheet1最終行
Dim MaxRow2 As Long ' Sheet2最終行
Dim key As String ' 検索キー
Dim row1 As Long 'sheet1の行番号
Dim row2 As Long 'sheet2の行番号
Dim dicT As Object '連想配列
Dim kaiNo As Long '回次番号
Dim col2No As Long 'Sheet2へ設定する列の番号
Dim exec_count As Long '処理件数
Dim skip_count As Long '未処理件数

Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義

Set Sh1 = Worksheets("Sheet1") ' 出席者一覧
Set Sh2 = Worksheets("Sheet2") ' 会員名簿
kaiNo = Sh1.Cells(2, 2).Value
If kaiNo < 1 Or kaiNo > 30 Then
MsgBox ("回次不正:" & kaiNo)
Exit Sub
End If
col2No = 8 + kaiNo

Application.ScreenUpdating = False
MaxRow1 = Sh1.Cells(Rows.Count, 2).End(xlUp).row ' Sheet1のB列最終行を求める
MaxRow2 = Sh2.Cells(Rows.Count, 2).End(xlUp).row ' Sheet2のB列最終行を求める
'会員名簿から連想配列を作成
For row2 = 5 To MaxRow2
key = Sh2.Cells(row2, 2).Value '氏名をキーとする
dicT(key) = row2 '行番号を記憶
Next
'出席者一覧から会員連想配列を作成
exec_count = 0
skip_count = 0
For row1 = 5 To MaxRow1
key = Sh1.Cells(row1, 2).Value '氏名をキーとする
'出席者が会員名簿に存在するか
If dicT.exists(key) = True Then
'存在する場合
row2 = dicT(key) '該当者の行番号を取得
Sh2.Cells(row2, col2No).Value = "●"
exec_count = exec_count + 1
Else
'存在しない場合
MsgBox (row1 & "行の[" & key & "]は会員名簿になし")
skip_count = skip_count + 1
End If
dicT(key) = row2 '行番号を記憶
Next
Application.ScreenUpdating = True
MsgBox ("処理完了 処理件数=" & exec_count & " 未処理件数=" & skip_count)
End Sub
----------------------------------------------------------------------------
データが今後、多くなるということなので、高速に検索できる方法を採用しました。
連想配列(Scripting.Dictionary)を使用しています。
これによりデータが少ない間は、あまり体感できませんが、データが増えたとき、快適に動作することが体感できます。
「VBAで、検索してあったら入力位置を取得」の回答画像3
    • good
    • 0
この回答へのお礼

tatsu99 様
おはようございます。
解説付きで、しかもスピーディーにコードを提示いただきありがとうございます。
仕事中なので今夜にでもじっくり読み解いてみますが、
こんな複雑なコードが必要だったとは・・・
私にできるはずがありません。

取り急ぎお礼申し上げます。

お礼日時:2016/11/17 09:23

No.4・5です。



>ユーザー定義から
>第0回
>としておき、入力は数値のみの入力とします。
>の意味が理解できず・・・

要するにセルの表示形式の問題ですね?
前回のコードは表示形式が異なれば何も変化ないと思います。
画面上では「第5回」のように見えていますが、実データは「5」になります。
(入力は単に数値の 5 だけの入力)

Sheet1のB2セル上で右クリック → セルの書式設定 → 「表示形式」タブが表示され、「標準」が選択されていると思います。
その欄にある一番下の「ユーザー定義」を選択 → 種類の欄で「G/標準」となっているところを消去 → 第0回 と入力しOK
そしてB2セルは表示したい数値、仮に 3 と入力すると 第3回 と表示されます。
次にSheet2のI4セル~AL4セルを範囲指定し、同様にセルの表示形式を変更し、そのセルには 1~30 までの数値のみの入力!
これで「第○回」のように表示されますので、前回のコードで動くと思います。

※ Sheet1のB2セル・Sheet2のI4~AL4セルのセルの表示形式が異なれば
記載したコードに手を加える必要があります。m(_ _)m
    • good
    • 0
この回答へのお礼

tom04 様
親切にご教示いただきありがとうございます。
ユーザー定義を変更して動作を確認することができました。
ネットで検索し、それに少し手を加えてマクロを作成するくらいのレベルですので、いろんな書き方があることがとても勉強になりました。
また質問させていただくと思いますがよろしくお願いします。

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

お礼日時:2016/11/18 11:57

No.4です。



前回のコードではエラーで止まってしまう可能性があります。
前回のコードはすべて消去し↓のコードに変更してください。

Sub Sample2()
Dim i As Long, c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
On Error Resume Next
For i = 5 To .Cells(Rows.Count, "B").End(xlUp).Row 'Sheet1の5行目からB列最終行まで//
Set c = wS.Range("B:B").Find(what:=.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
Set r = wS.Rows(4).Find(what:=Format(.Range("B2"), "第0回"), LookIn:=xlValues, lookat:=xlWhole)
wS.Cells(c.Row, r.Column) = "●"
Next i
End With
End Sub

※ 検証せずに投稿してごめんなさい。m(_ _)m
この回答への補足あり
    • good
    • 0

こんばんは!



横からお邪魔します。
>同じ名前があったら・・・

ない場合はなにもしなくて良いのですね?
一例です。
Sheet1もSheet2も
>5行目から下行にデータが入り・・・
というコトですので、↓の画像のように4行目が項目行になっているとします。
尚、↓の画像の薄い黄色のセル(第〇回のセル)は両シートともセルの表示形式を
ユーザー定義から
第0回
としておき、入力は数値のみの入力とします。

標準モジュールにしてください。

Sub Sample1()
Dim i As Long, c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
For i = 5 To .Cells(Rows.Count, "B").End(xlUp).Row 'Sheet1の5行目からB列最終行まで//
Set c = wS.Range("B:B").Find(what:=.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
Set r = wS.Rows(4).Find(what:=Format(.Range("B2"), "第0回"), LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing And Not r Is Nothing Then
wS.Cells(c.Row, r.Column) = "●"
End If
Next i
End With
End Sub

こんな感じではどうでしょうか?m(_ _)m
「VBAで、検索してあったら入力位置を取得」の回答画像4
    • good
    • 0

No1です。


1)Sheet1のデータは何件(=行数ー4)ほどありますか。
2)Sheet2のデータは何件(=行数ー4)ほどありますか。
の質問の意図は、処理時間をどの程度考慮するかどうかの為です。
データが1000~2000件程度でしたら、普通の方法(総当たり方式)で検索しても、問題ないですが、
多量にデータがある場合(例えば1万件以上)の場合は、処理時間を短縮する為、別途、検索方法を考慮する必要があります。
この回答への補足あり
    • good
    • 0

補足要求です。


1)Sheet1のデータは何件(=行数ー4)ほどありますか。
2)Sheet2のデータは何件(=行数ー4)ほどありますか。
3)Sheet2の中で、名前の重複はないと考えて良いですか。(田中正雄さんが2人いないですか)
4)Sheet1の中で、名前の重複があると、Sheet2の同じ個所が2回●印が設定されますが、それで良いですか。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!