Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4427 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【56722】ワークシートをまたがる検索と結果自動入力 まっつん 08/7/2(水) 0:52 質問[未読]
【56723】Re:ワークシートをまたがる検索と結果自動... Abebobo 08/7/2(水) 9:06 発言[未読]
【56726】Re:ワークシートをまたがる検索と結果自動... まっつん 08/7/2(水) 10:53 お礼[未読]
【56725】Re:ワークシートをまたがる検索と結果自動... Yuki 08/7/2(水) 10:20 発言[未読]
【56727】Re:ワークシートをまたがる検索と結果自動... まっつん 08/7/2(水) 11:01 お礼[未読]
【56722】ワークシートをまたがる検索と結果自動入...
質問  まっつん  - 08/7/2(水) 0:52 -
引用なし
パスワード
   はじめまして、まっつんと申します。まったくの初心者ですが、宜しくお願いします。
使用バージョンは、Excel 2004 for Mac, ver 11.5 です。

ワークシートが３枚あり、Sheet1, Sheet2, Sheet3とします。
それぞれ、人名と生年月日などが入っているテーブルです。
Sheet1のテーブルに、Sheet2、Sheet3にも登録されている人名があるかどうか印をつけたいのです。
Sheet1は次のような構成です。
A　　　　　 B　　　　　 C
（空欄）人名　　生年月日

Sheet2, 3は次のような構成です。
A　　　　　B
人名　　何らかの日付

Sheet1上の人名がSheet2A列にもあれば、Sheet1のA列に行番号と記号「A」を　(例1-A)、
Sheet1上の人名がSheet3A列にもあれば、Sheet1のA列に行番号と記号「B」を　(例1-B)、
Sheet1上の人名がSheet2A列にもSheet3A列にもあれば、Sheet1のA列に行番号と記号「A/B」を(例1-A/B)、
空欄であるSheet1のA列に自動的に入力して行く、というイメージです。

手動で人名を検索するのにmatch関数を使って上手くいっていたので、VBAでもmatch関数を使ってみました。（特にmatch関数にこだわっているわけではありません）

Dim myCell As Variant
Dim R1, R2 As Variant
Dim Line as Integer

Line = 1

For Each myCell In Worksheets("Sheet1").Range("B2:B110")
　　R1 = Application.Match(myCell.Value, Worksheets("Sheet2").Range("A2:A100"), 0)
　　On Error GoTo 0
　　R2 = Application.Match(myCell.Value, Worksheets("Sheet3").Range("A2:A100"), 0)
　　On Error GoTo 0

　　If (R1 <> xlErrNA) And (R2 <> xlErrNA) Then
　　　Worksheets("Sheet1").Cells(Line, 1).Value = (Line & " -A/B")
　　ElseIf (R1 = xlErrNA) And (R2 <> xlErrNA) Then
　　　Worksheets("Sheet1").Cells(Line, 1).Value = (Line & " -B")
　　ElseIf (R1 <> xlErrNA) And (R2 = xlErrNA) Then
　　　Worksheets("Sheet1").Cells(Line, 1).Value = (Line & " -A")
　　Else
　　　Worksheets("Sheet1").Cells(Line, 1).Value = Line　　
　　End If

　　Line = Line + 1
Next

というようなコードを無理矢理書いてみました。たまに初めの一回だけ動いたりするのですが、match関数の引数の型が悪いと、エラー1004で止まります。If文でも型が合わないというエラーになることがあります。

根本的にとっても馬鹿な事をやっているのかもしれませんが、何が悪いのか気付かないくらいの初心者です・・・。アドバイスいただけたら幸甚です。宜しくお願いいたします。
【56723】Re:ワークシートをまたがる検索と結果自...
発言  Abebobo  - 08/7/2(水) 9:06 -
引用なし
パスワード
   まっつん さん おはようございます。
Findで　こんな感じで作ってみました。

Sub kensaku()
Dim Mycell As Range
Dim FoundA As Range
Dim FoundB As Range

For Each Mycell In Worksheets("Sheet1").Range("B2:B110")
　' ↓　検索して見つかったセルを、変数FoundA　に入れる
　Set FoundA = Worksheets("Sheet2").Range("A2:A110").Find(CStr(Mycell.Value))
　If Not FoundA Is Nothing Then　'入ったかどうかの確認
　　Mycell.Offset(0, -1).Value = FoundA.Row & "A"
　End If
　Set FoundB = Worksheets("Sheet3").Range("A2:A110").Find(CStr(Mycell.Value))
　If Not FoundB Is Nothing Then
　　If Mycell.Offset(0, -1).Value = "" Then
　　　Mycell.Offset(0, -1).Value = FoundB.Row & "B"
　　Else
　　　Mycell.Offset(0, -1).Value = Mycell.Offset(0, -1).Value & "/" & FoundB.Row & "B"
　　End If
　End If
Next Mycell
End Sub
【56725】Re:ワークシートをまたがる検索と結果自...
発言  Yuki  - 08/7/2(水) 10:20 -
引用なし
パスワード
   ▼まっつん さん：
こんにちは。
ディクショナリでしてみました。
Sub TEST()
　　Dim Dic As Object
　　Dim vA　As Variant
　　Dim vD1 As Variant
　　Dim vD2 As Variant
　　Dim i　 As Long
　　
　　Set Dic = CreateObject("Scripting.Dictionary")
　　With Worksheets("Sheet1")
　　　　vA = .Range("A2:B" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
　　End With
　　
　　With Worksheets("Sheet2")
　　　　vD1 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
　　End With
　　
　　With Worksheets("Sheet3")
　　　　vD2 = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
　　End With
　　
　　For i = 1 To UBound(vA)
　　　　Dic(vA(i, 2)) = i
　　Next
　　
　　For i = 1 To UBound(vD1)
　　　　If Dic.Exists(vD1(i, 1)) Then
　　　　　　vA(Dic(vD1(i, 1)), 1) = i + 1 & "-A"
　　　　End If
　　Next
　　For i = 1 To UBound(vD2)
　　　　If Dic.Exists(vD2(i, 1)) Then
　　　　　　If vA(Dic(vD2(i, 1)), 1) = "" Then
　　　　　　　　vA(Dic(vD2(i, 1)), 1) = i + 1 & "-B"
　　　　　　Else
　　　　　　　　vA(Dic(vD2(i, 1)), 1) = _
　　　　　　　　vA(Dic(vD2(i, 1)), 1) & "/" & i + 1 & "-B"
　　　　　　　　　　　　　　　　　　　　　　　'AとBの行番号が違う
　　　　　　　　'vA(Dic(vD2(i, 1)), 1) & "/B" '質問通りだったら入れ替え
　　　　　　End If
　　　　End If
　　Next
　　Set Dic = Nothing
　　
　　With Worksheets("Sheet1")
　　　　.Columns(1).ClearContents
　　　　.Range("A2").Resize(UBound(vA)).Value = vA
　　End With
End Sub
【56726】Re:ワークシートをまたがる検索と結果自...
お礼  まっつん  - 08/7/2(水) 10:53 -
引用なし
パスワード
   ▼Abebobo さん：

早速のご回答、ありがとうございました！
番号打ちのIf文のあたりを一部カスタマイズしましたが
（私の説明が下手でした、すみません・・・）
無事、やりたい事ができました！！
大変勉強になりました。本当にありがとうございました！
【56727】Re:ワークシートをまたがる検索と結果自...
お礼  まっつん  - 08/7/2(水) 11:01 -
引用なし
パスワード
   ▼Yuki さん：

こんにちは、ご回答ありがとうございます！
なるほど、ディクショナリというやり方もあったのですね・・・。
全然思いつきませんでした（その機能自体知りませんでした（汗））。
是非試させていただきます！ありがとうございました m(_ _)m
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4427 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free