VBAの検索で検索できなかったデータを明示したい

http://oshiete.goo.ne.jp/qa/7878567.html　のベストアンサーのVBAで
検索できなかった「生徒番号」があった場合にそのデータを明示できる方法を教えてください。

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

• WindFallerさん　いつも親切な回答ありがとうございます
  
  質問文がわかりにくくてすみません。
  >「生徒番号」があった場合にそのデータを明示できる　ではなく
  >検索できなかった「生徒番号」があった場合で、
  
  例えばsheet2に12010があって,sheet2には12010がなかった場合12010を表示したいのです。

    補足日時：2016/11/27 14:16

• 質問が正確に伝わらないようです。補足説明が間違っていました。
  
  例えばsheet2に12010があって,sheet１には12010がなかった場合12010を表示したいのです。

    補足日時：2016/11/27 14:46

• bonaronさん　　回答ありがとうございます。
  
  試してみたところ2行目の
  Dim dbCon As New ADODB.Connection
  でコンパイルエラー、「ユーザー定義型は定義されていません」でエラーになります。

    補足日時：2016/11/28 09:24

• 「Microsoft ActiveX Data Objects 6.1 Library」参照設定して試したところ
  
  dbRst.Open strSQL, dbCon, adOpenForwardOnly, adLockOptimistic　の行で
  「式で型が一致しません」でエラーになります。
  
  参照設置を「Microsoft ActiveX Data Objects 2.8 Library」に変えて試してみましたが同じ結果になりました。

  No.4の回答に寄せられた補足コメントです。 補足日時：2016/11/28 10:53

• 回答ありがとうございます。
  
  コードを実行すると未登録の生徒がsheet３に出力されますが、本来の目的の「転記」が出来ていません。

  No.5の回答に寄せられた補足コメントです。 補足日時：2016/11/29 07:56

No.8 回答者： bonaron 回答日時： 2016/11/30 02:46

No.4 です。

> dbRst.Open strSQL, dbCon, adOpenForwardOnly, adLockOptimistic　の行で
> 「式で型が一致しません」でエラーになります。

データの問題でしょうね。
キーになる「生徒番号」で、一方は数値型、他方は文字列型と判断されているのでしょう。
詳しいことは省略しますが、
昔から、エクセルのデータをアクセスにインポートする場合などに
データ型をうまく判断してもらえないエラーが問題になるケースが ありましたが
これもそれですね。

無理やり工夫して正しく読ませるより、
ここはエクセルらしい方法に切り替えましょう。

No.5 さんの回答で問題になるのは
「生徒番号」「氏名」の２項目だけが出力される、ということで、
１行まるごとコピーされれば目的達成ですね？


No.5 さんの回答を一部修正してください。
　'・・・
　'Sheet3の見出し作成
　sh3.Rows(1).Value = sh2.Rows(1).Value '見出し行をコピー

　row3 = 2
　count = 0

　'Sheet3へデータを書き込む（Sheet2に存在しSheet1に存在しない生徒番号）
　MaxRow = sh2.Cells(Rows.count, 1).End(xlUp).Row ' Sheet2最終行を求める

　'Sheet1を２～最終行まで繰り返す
　For row2 = 2 To MaxRow
　　key = sh2.Cells(row2, 1).Value
　　'生徒番号がSheet1に存在しないならSheet3へ書き込む
　　If dicT.exists(key) = False Then
　　　sh3.Rows(row3).Value = sh2.Rows(row2).Value '行データをコピー
　　　count = count + 1
　　　row3 = row3 + 1
　　End If
　Next
　'・・・

この回答へのお礼

bonaron　さんのNo.3のコードで「生徒番号」を表示形式、標準から文字型に変更したら動きました。
但し、見出しが生徒番号、F2,F3,F4,F5,F6になりました。

bonaron さんのN0.8の回答のコードで私の目的の物はできるようになりました。
回答いただいた皆様、ありがとうございました。

お礼日時：2016/11/30 16:02

No.7 回答者： tatsu99 回答日時： 2016/11/29 10:59

No6です。

念の為ですが、実行するマクロは
「一度に実行」です。
そうすると、「Sample1」実行後、「未登録生徒表示」を実行します。

今迄通り、
「Sample1」だけを実行しても問題ありませんし、（当然Sample1の機能だけしか行われませんが）
「未登録生徒表示」だけを構いません。

No.6 回答者： tatsu99 回答日時： 2016/11/29 10:34

No5です。

＞コードを実行すると未登録の生徒がsheet３に出力されますが、本来の目的の「転記」が出来ていません。

「http://oshiete.goo.ne.jp/qa/7878567.html　のベストアンサーのVBA」のマクロ名は

Sample1()　で間違いないでしょうか。

以下のマクロを更に追加してください。
----------------------------------------
Public Sub 一度に実行()
Call Sample1
Call 未登録生徒表示
End Sub
----------------------------------------
そうすると、前回のベストアンサーのVBA実行後、NO5で提示したマクロが自動的に実行されます。
もし、Sample1が前回のベストアンサーのVBAでない場合は、そのマクロ名に変えてください。

No.5 回答者： tatsu99 回答日時： 2016/11/28 17:42

以下のマクロを標準モジュールへ登録してください。

Sheet2に存在し、Sheet1に存在しない生徒番号をSheet3へ出力します。
----------------------------------------------------------------
Option Explicit
Public Sub 未登録生徒表示()
Dim sh1, sh2, sh3 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim row1 As Long 'sheet1の行番号
Dim row2 As Long 'sheet2の行番号
Dim row3 As Long 'sheet3の行番号
Dim count As Long '未登録生徒件数
Dim dicT As Object '連想配列
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set sh3 = Worksheets("Sheet3")
MaxRow = sh1.Cells(Rows.count, 1).End(xlUp).row ' Sheet1最終行を求める
'Sheet1を２～最終行まで繰り返す
For row1 = 2 To MaxRow
key = sh1.Cells(row1, 1).Value
'生徒番号を連想配列に記憶する
dicT(key) = True
Next
'Sheet3の見出し作成
sh3.Cells(1, 1) = "生徒番号"
sh3.Cells(1, 2) = "氏名番号"
row3 = 2
count = 0
'Sheet3へデータを書き込む（Sheet2に存在しSheet1に存在しない生徒番号）
MaxRow = sh2.Cells(Rows.count, 1).End(xlUp).row ' Sheet2最終行を求める
'Sheet1を２～最終行まで繰り返す
For row2 = 2 To MaxRow
key = sh2.Cells(row2, 1).Value
'生徒番号がSheet1に存在しないならSheet3へ書き込む
If dicT.exists(key) = False Then
sh3.Cells(row3, 1).Value = sh2.Cells(row2, 1).Value '生徒番号
sh3.Cells(row3, 2).Value = sh2.Cells(row2, 2).Value '氏名
count = count + 1
row3 = row3 + 1
End If
Next
MsgBox ("未登録の生徒件数=" & count)
End Sub
---------------------------------------------------
Sheet3は空のシートを作成しておいてからマクロを実行してください。
（Sheet1,Shhet2,Sheet3が存在しないとエラーになります）

No.4 回答者： bonaron 回答日時： 2016/11/28 09:39

> でコンパイルエラー、「ユーザー定義型は定義されていません」でエラーになります。

> 「Microsoft ActiveX Data Objects x.x Library」への参照設定が必要です。
と書きました。

No.3 回答者： bonaron 回答日時： 2016/11/28 02:50

> 例えばsheet2に12010があって,sheet１には12010がなかった場合12010を表示したいのです。

リンク先とは逆ですね。

sheet2 にあって,sheet1 にはないものを sheet3 に表示する例です。
Excel らしくない方法ですが。

Sub Sample1()
　　Dim dbCon As New ADODB.Connection
　　Dim dbRst As New ADODB.Recordset
　　Dim strSQL As String
　　Dim i As Long

　　' Connection生成
　　With dbCon
　　　　.Provider = "Microsoft.ACE.OLEDB.12.0"
　　　　.Properties("Extended Properties") = "Excel 12.0"
　　　　.Open ThisWorkbook.FullName
　　End With

　　' SQL文作成
　　strSQL = "SELECT [Sheet2$].* FROM [Sheet2$] Left Join [Sheet1$] " & _
　　　　　　　"ON [Sheet2$].[生徒番号] = [Sheet1$].[生徒番号] " & _
　　　　　　　"Where [Sheet1$].[生徒番号] Is Null "

　　' Recordset を開く
　　dbRst.Open strSQL, dbCon, adOpenForwardOnly, adLockOptimistic
　　' sheet3 に貼り付け
　　For i = 0 To dbRst.Fields.Count - 1
　　　　Worksheets("Sheet3").Cells(1, i + 1) = dbRst.Fields(i).Name
　　Next
　　Worksheets("Sheet3").Range("A2").CopyFromRecordset dbRst

　　dbRst.Close: Set dbRst = Nothing
　　dbCon.Close: Set dbCon = Nothing
End Sub

「Microsoft ActiveX Data Objects x.x Library」への参照設定が必要です。
Excel 2003 以前だと 接続文字列が違ってくるかもしれません。

No.2 回答者： WindFaller 回答日時： 2016/11/27 14:26

補足に対する返事：

でしたら、このように、Sheet2 の最後尾に、検索したデータを貼り付ける方法はどうでしょうか。


For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
　　Set c = wS2.Columns(1).Find(what:=wS1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
　　If Not c Is Nothing Then
　　　n = c.Row
　　　wS2.Cells(n, 3).Resize(1, 4).Copy wS1.Cells(i, 4)
　　Else
　　　wS2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = _
　　　wS1.Cells(i, 1).Resize(, 2).Value
　　　
　　End If
Next i

No.1 回答者： WindFaller 回答日時： 2016/11/27 13:35

回答者の方は、現在も活躍していますので、ご本人からもコメントがあるかもしれませんが、私からも回答しておきます。

>「生徒番号」があった場合にそのデータを明示できる

こちらの任意でよいなら、Debug.Print のイミディエイトウィンドウに記録することになります。

Sheet1 の方を、「名簿リスト」とし、Sheet2 を、「テスト結果」とすると、「テスト結果」側にはあって、「名簿リスト」にはない、ということは、試験時休みの人をピックアップするという意味になりますね。

　For i = 2 To wS1.Cells(Rows.Count, 1).End(xlUp).Row
　　Set c = wS2.Columns(1).Find(what:=wS1.Cells(i, 1), LookIn:=xlValues, lookat:=xlWhole)
　　If Not c Is Nothing Then
　　　n = c.Row
　　　wS2.Cells(n, 3).Resize(1, 4).Copy wS1.Cells(i, 4)
　　Else
　　　Debug.Print wS1.Cells(i, 1).Value, wS1.Cells(i, 2).Value
　　End If
　Next i