Excel VBA質問箱 IV

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

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


25351 / 76732 ←次へ | 前へ→

【56722】ワークシートをまたがる検索と結果自動入力
質問  まっつん  - 08/7/2(水) 0:52 -

引用なし
パスワード
   はじめまして、まっつんと申します。まったくの初心者ですが、宜しくお願いします。
使用バージョンは、Excel 2004 for Mac, ver 11.5 です。

ワークシートが3枚あり、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文でも型が合わないというエラーになることがあります。

根本的にとっても馬鹿な事をやっているのかもしれませんが、何が悪いのか気付かないくらいの初心者です・・・。アドバイスいただけたら幸甚です。宜しくお願いいたします。
0 hits

【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 お礼

25351 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free