Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

976 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【76750】シート1とシート2の内容で一致するものがあれば結果表示をさせたい あや 15/3/9(月) 16:01

【76751】Re:シート1とシート2の内容で一致するもの... β 15/3/9(月) 16:49

【76752】Re:シート1とシート2の内容で一致するもの... β 15/3/9(月) 17:20

【76761】Re:シート1とシート2の内容で一致するもの... あや 15/3/10(火) 11:20

【76764】Re:シート1とシート2の内容で一致するもの... β 15/3/10(火) 13:20

【76765】Re:シート1とシート2の内容で一致するもの... あや 15/3/10(火) 14:14

【76766】Re:シート1とシート2の内容で一致するもの... β 15/3/10(火) 16:17

【76791】Re:シート1とシート2の内容で一致するもの... あや 15/3/12(木) 21:04

【76793】Re:シート1とシート2の内容で一致するもの... β 15/3/12(木) 21:44

【76798】Re:シート1とシート2の内容で一致するもの... あや 15/3/16(月) 19:51

【76799】Re:シート1とシート2の内容で一致するもの... あや 15/3/16(月) 20:22

【76800】Re:シート1とシート2の内容で一致するもの... β 15/3/16(月) 21:42

【76801】Re:シート1とシート2の内容で一致するもの... あや 15/3/17(火) 9:55

【76802】Re:シート1とシート2の内容で一致するもの... β 15/3/17(火) 11:04

【76803】Re:シート1とシート2の内容で一致するもの... あや 15/3/17(火) 13:13

【76804】Re:シート1とシート2の内容で一致するもの... あや 15/3/17(火) 13:17

【76806】Re:シート1とシート2の内容で一致するもの... β 15/3/17(火) 15:18

【76815】Re:シート1とシート2の内容で一致するもの... あや 15/3/18(水) 8:57

【76816】Re:シート1とシート2の内容で一致するもの... β 15/3/18(水) 9:09

【76817】Re:シート1とシート2の内容で一致するもの... β 15/3/18(水) 9:20

【76818】Re:シート1とシート2の内容で一致するもの... β 15/3/18(水) 9:37

【76822】Re:シート1とシート2の内容で一致するもの... あや 15/3/18(水) 18:30

【76823】Re:シート1とシート2の内容で一致するもの... β 15/3/18(水) 19:48

【76825】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 9:38

【76826】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 10:03

【76827】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 11:12

【76828】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 15:33

【76829】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 15:46

【76830】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 16:14

【76831】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 16:17

【76834】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 17:28

【76835】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 18:02

【76836】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 18:14

【76838】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 19:15

【76837】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 19:07

【76839】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 19:33

【76840】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 19:50

【76841】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 20:04

【76842】Re:シート1とシート2の内容で一致するもの... あや 15/3/19(木) 20:11

【76843】Re:シート1とシート2の内容で一致するもの... β 15/3/19(木) 20:14

【76845】Re:シート1とシート2の内容で一致するもの... あや 15/3/23(月) 10:42

【76846】Re:シート1とシート2の内容で一致するもの... β 15/3/23(月) 19:26

【76849】Re:シート1とシート2の内容で一致するもの... あや 15/3/24(火) 10:11

【76851】Re:シート1とシート2の内容で一致するもの... β 15/3/24(火) 13:36

【77107】Re:シート1とシート2の内容で一致するもの... あや 15/5/22(金) 9:38

【77110】Re:シート1とシート2の内容で一致するもの... β 15/5/22(金) 13:23

【77111】Re:シート1とシート2の内容で一致するもの... β 15/5/22(金) 14:41

【77112】Re:シート1とシート2の内容で一致するもの... あや 15/5/22(金) 15:35

【77114】Re:シート1とシート2の内容で一致するもの... β 15/5/22(金) 17:57

【77115】Re:シート1とシート2の内容で一致するもの... あや 15/5/22(金) 19:30

【77116】Re:シート1とシート2の内容で一致するもの... β 15/5/22(金) 19:47

【77144】Re:シート1とシート2の内容で一致するもの... あや 15/5/26(火) 10:11

【77145】Re:シート1とシート2の内容で一致するもの... β 15/5/26(火) 12:04

【77153】Re:シート1とシート2の内容で一致するもの... β 15/5/27(水) 22:49

【77157】Re:シート1とシート2の内容で一致するもの... あや 15/5/28(木) 14:05

【77158】Re:シート1とシート2の内容で一致するもの... β 15/5/28(木) 16:48

【77159】Re:シート1とシート2の内容で一致するもの... あや 15/5/28(木) 19:57

【77160】Re:シート1とシート2の内容で一致するもの... β 15/5/28(木) 20:31

【77165】Re:シート1とシート2の内容で一致するもの... あや 15/5/29(金) 19:16

【77166】Re:シート1とシート2の内容で一致するもの... β 15/5/29(金) 21:40

【77167】Re:シート1とシート2の内容で一致するもの... β 15/5/29(金) 21:43

【77168】Re:シート1とシート2の内容で一致するもの... β 15/5/30(土) 6:17

【77170】Re:シート1とシート2の内容で一致するもの... あや 15/6/1(月) 14:17

【77171】Re:シート1とシート2の内容で一致するもの... β 15/6/1(月) 15:44

【77172】Re:シート1とシート2の内容で一致するもの... あや 15/6/1(月) 16:37

【77174】Re:シート1とシート2の内容で一致するもの... β 15/6/1(月) 17:11

【77175】Re:シート1とシート2の内容で一致するもの... β 15/6/1(月) 20:28

【76805】Re:シート1とシート2の内容で一致するもの... あや 15/3/17(火) 13:31

【76809】Re:シート1とシート2の内容で一致するもの... β 15/3/17(火) 17:14

【76767】Re:シート1とシート2の内容で一致するもの... β 15/3/10(火) 18:13

【76790】Re:シート1とシート2の内容で一致するもの... あや 15/3/12(木) 21:01

【76754】Re:シート1とシート2の内容で一致するもの... マナ 15/3/9(月) 19:27

【76762】Re:シート1とシート2の内容で一致するもの... あや 15/3/10(火) 11:24


	【76750】シート1とシート2の内容で一致するものが...

あや - 15/3/9(月) 16:01 -


	引用なし

	パスワード

はじめまして。BVA初心者のあやです。シートが異なるものに関して検索をかけ、引っかかったものの結果を表示させたいのですが、どういうような組立で行えばよいか整理ができず、いろいろ試してはいますが上手くいきません。アドバイスをいただけたらと思います。例えばなのですが、 1.シート2のA列に東京都在住の人の名前が多数記入されていて、　シート3のA列に大阪府在住の人の名前が多数記入されています 2.シート1上の”スタート”というボタンを押す 3.シート2の中にシート3と同じ名前の人がいるか探す 4.一致した場合はシート1上でメッセージボックスとかで結果表示させる ※シート2の名前の方をベースにし、シート3の中でシート2と同じものがあれば、シート3で見つかった方の結果を表示させたいです。もし、同じ名前の人が複数いる場合(シート2:山田一人、シート3：山田　三人)、もしくは2と3で同じ苗字が多数いる場合(シート2:山田・佐藤、シート3：山田・佐藤) はそれら全てを結果表示できるようにしたいのです。。。結果表示例)|---------------|　　　 |---------------| 　　　　　 |検索結果：山田 |　　　 |検索結果：山田 | 　　　　　 |　　　　　山田 |　や　 |　　　　佐藤 |　など・・　　　　　|　　　　　山田 |　　　 |　　　　　　　 | 　　　　　 |---------------|　　　 |---------------| ネットや本でもいろいろ調べ、試してみましたが、なかなか上手くいきません・・・どなたかご教授願います。また、初心者の為、出来れば簡単なコードやシンプルなプログラムを使用したり、解説をしていただければとてもありがたいです。。。みなさまどうぞよろしくお願い致します。


	【76751】Re:シート1とシート2の内容で一致するも...

β - 15/3/9(月) 16:49 -


	引用なし

	パスワード

▼あやさん：

シンプルな方法ということですので以下ではいかがですか？

１．Sheet2のA列をSheet1のA列にコピペ
２．Sheet1のA列を選択して、データタブの重複の削除でユニークな名前群にする
３．Sheet3にオートフィルター設定（１行目がタイトル行でなければいけませんが）
４．Sheet1のユニークになった名前を取り出して、Sheet3のA列をフィルタリング
５．抽出されたら、Sheet3の抽出領域を選択して、Sheet1 の下のほうにコピペ
６．この４．と５．をループで繰り返し

ループ以外はマクロ記録で基本的なコードが生成されますから、あとは、このコードで
固定になった部分を、がんばって変数化。

もちろん、もっと「ＶＢＡ的な」処理方法は、いろいろありますが、
この方法が、結構わかりやすいですよ。
（一度、手作業で操作して確認してみてください）


	【76752】Re:シート1とシート2の内容で一致するも...

β - 15/3/9(月) 17:20 -


	引用なし

	パスワード

▼あやさん：

こんなコードもあります。
シンプルですが、わかりにくいかも。

Sub Test()
　　Dim dic As Object
　　Dim dl As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dl = CreateObject("System.Collections.ArrayList")
　　
　　With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = True
　　　　Next
　　End With
　　
　　With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then dl.Add c.Value
　　　　Next
　　End With
　　
　　If dl.Count > 0 Then
　　　　dl.Sort
　　　　ReDim v(0 To dl.Count - 1)
　　　　For i = 0 To dl.Count - 1
　　　　　　v(i) = dl(i)
　　　　Next
　　　　MsgBox "以下の重複がありました" & vbLf & Join(v, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If
　　
End Sub


	【76754】Re:シート1とシート2の内容で一致するも...

マナ - 15/3/9(月) 19:27 -


	引用なし

	パスワード

マクロの記録で作成する例です。
最後のメッセージボックスだけはちょっと無理でしたので
シート１のA列にコピペにしました。

１．Sheet3のA1に行挿入
２．Sheet3のA1に「大阪」と入力
３．Sheet3のB2に式入力　=COUNTIF(Sheet2!A:A,A2)
４．Sheet3のB列を下方向にフィルコピー
５．Sheet3でオートフィルター
６．Sheet3のB列で数値フィルター　0と等しくない
７．Sheet3のA列抽出行をSheet1のA列にコピペ
８．Sheet3のオートフィルター解除
９．Sheet3のB列削除
１０．Sheet3の１行目を選択し行削除


	【76761】Re:シート1とシート2の内容で一致するも...

あや - 15/3/10(火) 11:20 -


	引用なし

	パスワード

▼β さん：
2パターンの情報提供、またコードまで書いていただき有難うございます。
最初の方が簡単そうだったので作成してみましたが、シート1はきれいなままにしておきたいので、2つ目の方法で進めていきたいと思います。
部分部分分からないところがあるので教えていただきたいのですがよろしいでしょうか？
1.>　　　　　　If dic.exists(c.Value) Then dl.Add c.Value
　この行のThen dl.Add c.Valueはどういう処理を行っているのでしょうか
2.>　　　　dl.Sort
　>　　　　ReDim v(0 To dl.Count - 1)
　>　　　　For i = 0 To dl.Count - 1
　>　　　　　　v(i) = dl(i)
　ここでどのような処理を行っているのでしょうか・・・
　ReDimが重複しているものも表示するものというのはわかったのですが・・・

また追加で質問があります。
同じ名前を発見した場合は最初に発見した方だけ表示するようにするには
>　　　　ReDim v(0 To dl.Count - 1)
を削除するほかに
>　　If dl.Count > 0 Then
>　　　　dl.Sort
>　　　　ReDim v(0 To dl.Count - 1)
>　　　　For i = 0 To dl.Count - 1
>　　　　　　v(i) = dl(i)
ここをどう変更すればよいのでしょうか・・・
”型が一致しません”や”オブジェクトが無効です”などのエラーが出てきてしまいます・・・
どういう処理をしているか解れば解決するのかな、とは思っているのですが・・・

質問ばかりで申し訳ありません。
回答宜しくお願い致します。

>▼あやさん：
>
>こんなコードもあります。
>シンプルですが、わかりにくいかも。
>
>Sub Test()
>　　Dim dic As Object
>　　Dim dl As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set dl = CreateObject("System.Collections.ArrayList")
>　　
>　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = True
>　　　　Next
>　　End With
>　　
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then dl.Add c.Value
>　　　　Next
>　　End With
>　　
>　　If dl.Count > 0 Then
>　　　　dl.Sort
>　　　　ReDim v(0 To dl.Count - 1)
>　　　　For i = 0 To dl.Count - 1
>　　　　　　v(i) = dl(i)
>　　　　Next
>　　　　MsgBox "以下の重複がありました" & vbLf & Join(v, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>　　
>End Sub


	【76762】Re:シート1とシート2の内容で一致するも...

あや - 15/3/10(火) 11:24 -


	引用なし

	パスワード

▼マナさん：
回答ありがとうございます。
マクロを使う方法なのですね。
試してみます。

>マクロの記録で作成する例です。
>最後のメッセージボックスだけはちょっと無理でしたので
>シート１のA列にコピペにしました。
>
>１．Sheet3のA1に行挿入
>２．Sheet3のA1に「大阪」と入力
>３．Sheet3のB2に式入力　=COUNTIF(Sheet2!A:A,A2)
>４．Sheet3のB列を下方向にフィルコピー
>５．Sheet3でオートフィルター
>６．Sheet3のB列で数値フィルター　0と等しくない
>７．Sheet3のA列抽出行をSheet1のA列にコピペ
>８．Sheet3のオートフィルター解除
>９．Sheet3のB列削除
>１０．Sheet3の１行目を選択し行削除


	【76764】Re:シート1とシート2の内容で一致するも...

β - 15/3/10(火) 13:20 -


	引用なし

	パスワード

▼あやさん：

まず、このコードは２つの入れ物を使っています。
１つが Dictionary と呼ばれるもの。もう１つがArrayListと呼ばれるものです。
いずれもＶＢＡの持ち物ではなく外部（.Net等）の機能なので、CreateObject で呼び出して使用。

Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
Sheet2の名前を格納するのに使っています。山田が何件あろうと１件の山田になります。

ArrayListは、キー／データという概念はないのですが同じ値を別のものとして格納可能です。
コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が３件あれば３件格納されます。
また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
エラーメッセージで
山田
佐藤
山田
佐藤
とだすより
山田
山田
佐藤
佐藤
とだすほうがわかりやすいので、この昇順並び替え機能を使っています。（これが dl.Sort です）

Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
判定ができます。それが　dic.exists(c.Value)　で、このメソッドが返す結果が True なら　
重複しているということになりますので、それを dl.Add c.Value　でArrayList に登録しています。

ArrayListに格納した内容は、ＶＢＡからは一挙に取り出せないので、ArrayListと同じ大きさの
ReDim v(0 To dl.Count - 1)　で１次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
v(i) = dl(i)　で、データを取り出しておさめています。
（ArrayListのインデックスは 0 から始まっています）

さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
集約して１件にして表示するなら、重複情報も ArrayListではなくDictionary に格納して重複をなくす
ことができます。

以下でお試しください。

Sub Test2()
　　Dim dic As Object
　　Dim dl As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　
　　Set dic = CreateObject("Scripting.Dictionary")
　　Set dl = CreateObject("Scripting.Dictionary")
　
　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = True
　　　　Next
　　End With
　
　　 With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then dl(c.Value) = True
　　　　Next
　　End With
　
　　If dl.Count > 0 Then
　　　　MsgBox "以下の重複がありました" & vbLf & Join(dl.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If
　
End Sub


	【76765】Re:シート1とシート2の内容で一致するも...

あや - 15/3/10(火) 14:14 -


	引用なし

	パスワード

▼β さん：
なるほど・・・
シート3で重複しているものも全て表示させようとしたため
dl.Add c.Valueという書き方をしているのですね。
また結果表示も同じものも表示させるために、重複を見つけるたびにv(i)に格納していくのですね。
有難うございます。

またまた質問で申し訳ないのですが・・・
1.今回の処理はセル同士を見比べているので、セルの値が完全一致のものを表示させていると思うのですが、これを部分一致にさせることというのは可能なのでしょうか(lookat:=xlPartのような・・・)
2.見比べはシート2とシート3のA列で行うのですが、結果表示をさせるときにシート2のA列の結果ではなく、シート2のB列の結果を表示させる、ということは可能でしょうか。
(B列に地区名が入っていて、知りたいのは重複した名前の人の地区というような・・・
dl.Offset(0, 1)を使うとうまくいかなかったもので・・・)

何度も申し訳ありません。

>▼あやさん：
>
>まず、このコードは２つの入れ物を使っています。
> １つが Dictionary と呼ばれるもの。もう１つがArrayListと呼ばれるものです。
>いずれもＶＢＡの持ち物ではなく外部（.Net等）の機能なので、CreateObject で呼び出して使用。
>
>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>Sheet2の名前を格納するのに使っています。山田が何件あろうと１件の山田になります。
>
>ArrayListは、キー／データという概念はないのですが同じ値を別のものとして格納可能です。
>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が３件あれば３件格納されます。
>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>エラーメッセージで
>山田
> 佐藤
> 山田
> 佐藤
>とだすより
>山田
> 山田
> 佐藤
> 佐藤
>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。（これが dl.Sort です）
>
>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>判定ができます。それが　dic.exists(c.Value)　で、このメソッドが返す結果が True なら　
> 重複しているということになりますので、それを dl.Add c.Value　でArrayList に登録しています。
>
>ArrayListに格納した内容は、ＶＢＡからは一挙に取り出せないので、ArrayListと同じ大きさの
>ReDim v(0 To dl.Count - 1)　で１次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>v(i) = dl(i)　で、データを取り出しておさめています。
> （ArrayListのインデックスは 0 から始まっています）
>
>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>集約して１件にして表示するなら、重複情報も ArrayListではなくDictionary に格納して重複をなくす
> ことができます。
>
> 以下でお試しください。
>
>Sub Test2()
>　　Dim dic As Object
>　　Dim dl As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　
> 　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set dl = CreateObject("Scripting.Dictionary")
>　
> 　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = True
>　　　　Next
>　　End With
>　
> 　　 With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then dl(c.Value) = True
>　　　　Next
>　　End With
>　
> 　　If dl.Count > 0 Then
>　　　　MsgBox "以下の重複がありました" & vbLf & Join(dl.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>　
>End Sub


	【76766】Re:シート1とシート2の内容で一致するも...

β - 15/3/10(火) 16:17 -


	引用なし

	パスワード

▼あやさん：

おっとぉ！
難易度がぐ～んとアップしましたね。
Dictionaryでの（直接）比較は、ワイルドカードがつかえませんので
すべてをなめて、Like 判定をするという手もありますが、ちょっと別の方法を考えてみます。
（老化進行防止のための、いいトレーニングになります）

ところで、部分一致ですが

Sheet2の語句がSheet3の語句と部分一致
Sheet3の語句がSheet2の語句と部分一致

どちらでしょうか？

なお、重複表示をB列にすることは問題ありません。

>▼β さん：
>なるほど・・・
>シート3で重複しているものも全て表示させようとしたため
>dl.Add c.Valueという書き方をしているのですね。
>また結果表示も同じものも表示させるために、重複を見つけるたびにv(i)に格納していくのですね。
>有難うございます。
>
>またまた質問で申し訳ないのですが・・・
>1.今回の処理はセル同士を見比べているので、セルの値が完全一致のものを表示させていると思うのですが、これを部分一致にさせることというのは可能なのでしょうか(lookat:=xlPartのような・・・)
>2.見比べはシート2とシート3のA列で行うのですが、結果表示をさせるときにシート2のA列の結果ではなく、シート2のB列の結果を表示させる、ということは可能でしょうか。
>(B列に地区名が入っていて、知りたいのは重複した名前の人の地区というような・・・
>dl.Offset(0, 1)を使うとうまくいかなかったもので・・・)
>
>何度も申し訳ありません。
>
>>▼あやさん：
>>
>>まず、このコードは２つの入れ物を使っています。
>> １つが Dictionary と呼ばれるもの。もう１つがArrayListと呼ばれるものです。
>>いずれもＶＢＡの持ち物ではなく外部（.Net等）の機能なので、CreateObject で呼び出して使用。
>>
>>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>>Sheet2の名前を格納するのに使っています。山田が何件あろうと１件の山田になります。
>>
>>ArrayListは、キー／データという概念はないのですが同じ値を別のものとして格納可能です。
>>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が３件あれば３件格納されます。
>>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>>エラーメッセージで
>>山田
>> 佐藤
>> 山田
>> 佐藤
>>とだすより
>>山田
>> 山田
>> 佐藤
>> 佐藤
>>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。（これが dl.Sort です）
>>
>>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>>判定ができます。それが　dic.exists(c.Value)　で、このメソッドが返す結果が True なら　
>> 重複しているということになりますので、それを dl.Add c.Value　でArrayList に登録しています。
>>
>>ArrayListに格納した内容は、ＶＢＡからは一挙に取り出せないので、ArrayListと同じ大きさの
>>ReDim v(0 To dl.Count - 1)　で１次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>>v(i) = dl(i)　で、データを取り出しておさめています。
>> （ArrayListのインデックスは 0 から始まっています）
>>
>>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>>集約して１件にして表示するなら、重複情報も ArrayListではなくDictionary に格納して重複をなくす
>> ことができます。
>>
>> 以下でお試しください。
>>
>>Sub Test2()
>>　　Dim dic As Object
>>　　Dim dl As Object
>>　　Dim i As Long
>>　　Dim v As Variant
>>　　Dim c As Range
>>　
>> 　　Set dic = CreateObject("Scripting.Dictionary")
>>　　Set dl = CreateObject("Scripting.Dictionary")
>>　
>> 　　 With Sheets("Sheet2")
>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>　　　　　　dic(c.Value) = True
>>　　　　Next
>>　　End With
>>　
>> 　　 With Sheets("Sheet3")
>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>　　　　　　If dic.exists(c.Value) Then dl(c.Value) = True
>>　　　　Next
>>　　End With
>>　
>> 　　If dl.Count > 0 Then
>>　　　　MsgBox "以下の重複がありました" & vbLf & Join(dl.keys, vbLf)
>>　　Else
>>　　　　MsgBox "重複はありませんでした"
>>　　End If
>>　
>>End Sub


	【76767】Re:シート1とシート2の内容で一致するも...

β - 15/3/10(火) 18:13 -


	引用なし

	パスワード

▼あやさん：

以下は、Sheet2の値が部分一致でSheet3にあるかどうかをみています。
不安ですが・・・
試してみてください。

Sub Test3()
　　Dim reg As Object
　　Dim dic As Object
　　Dim Dup As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　Dim str3 As String
　　
　　Set reg = CreateObject("VBScript.RegExp")　 '文字列比較エンジン
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")
　　
　　'Sheet3の名前を取り出してDicに格納
　　With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = True
　　　　Next
　　End With
　　
　　'Sheet3の各文字列を vbtab で挟み連結
　　str3 = vbTab & Join(dic.keys, vbTab) & vbTab
　　
　　'Sheet2の各文字列をSheet3の連結文字列とワイルドカード比較
　　With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　'ワイルドカード比較パターン
　　　　　　reg.Pattern = vbTab & ".*" & c.Value & ".*?" & vbTab
　　　　　　'Sheet3側にあればSheet2のB列の値を格納
　　　　　　If reg.Test(str3) Then Dup(c.Offset(, 1).Value) = True　　　　　　　　　　'
　　　　Next
　　End With
　
　　If Dup.Count > 0 Then
　　　　MsgBox "以下の地域に重複がありました" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If
　
End Sub


	【76790】Re:シート1とシート2の内容で一致するも...

あや - 15/3/12(木) 21:01 -


	引用なし

	パスワード

▼β さん：
返信が遅くなり、申し訳ありません。
毎回毎回丁寧に有難うございます。

因みに行いたかったのはSheet2の値がSheet3で部分一致するかどうかなので、下記ので試し、上手くいきました。本当にありがとうございます。

また悩み事が自身で解決できなくなりましたらまたご相談させてください・・・

>▼あやさん：
>
>以下は、Sheet2の値が部分一致でSheet3にあるかどうかをみています。
>不安ですが・・・
>試してみてください。
>
>Sub Test3()
>　　Dim reg As Object
>　　Dim dic As Object
>　　Dim Dup As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　Dim str3 As String
>　　
>　　Set reg = CreateObject("VBScript.RegExp")　 '文字列比較エンジン
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set Dup = CreateObject("Scripting.Dictionary")
>　　
>　　'Sheet3の名前を取り出してDicに格納
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = True
>　　　　Next
>　　End With
>　　
>　　'Sheet3の各文字列を vbtab で挟み連結
>　　str3 = vbTab & Join(dic.keys, vbTab) & vbTab
>　　
>　　'Sheet2の各文字列をSheet3の連結文字列とワイルドカード比較
>　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　'ワイルドカード比較パターン
>　　　　　　reg.Pattern = vbTab & ".*" & c.Value & ".*?" & vbTab
>　　　　　　'Sheet3側にあればSheet2のB列の値を格納
>　　　　　　If reg.Test(str3) Then Dup(c.Offset(, 1).Value) = True　　　　　　　　　　'
>　　　　Next
>　　End With
>　
>　　If Dup.Count > 0 Then
>　　　　MsgBox "以下の地域に重複がありました" & vbLf & Join(Dup.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>　
>End Sub


	【76791】Re:シート1とシート2の内容で一致するも...

あや - 15/3/12(木) 21:04 -


	引用なし

	パスワード

▼β さん：
判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・

>▼あやさん：
>
>おっとぉ！
>難易度がぐ～んとアップしましたね。
>Dictionaryでの（直接）比較は、ワイルドカードがつかえませんので
>すべてをなめて、Like 判定をするという手もありますが、ちょっと別の方法を考えてみます。
>（老化進行防止のための、いいトレーニングになります）
>
>ところで、部分一致ですが
>
>Sheet2の語句がSheet3の語句と部分一致
>Sheet3の語句がSheet2の語句と部分一致
>
>どちらでしょうか？
>
>なお、重複表示をB列にすることは問題ありません。
>
>
>>▼β さん：
>>なるほど・・・
>>シート3で重複しているものも全て表示させようとしたため
>>dl.Add c.Valueという書き方をしているのですね。
>>また結果表示も同じものも表示させるために、重複を見つけるたびにv(i)に格納していくのですね。
>>有難うございます。
>>
>>またまた質問で申し訳ないのですが・・・
>>1.今回の処理はセル同士を見比べているので、セルの値が完全一致のものを表示させていると思うのですが、これを部分一致にさせることというのは可能なのでしょうか(lookat:=xlPartのような・・・)
>>2.見比べはシート2とシート3のA列で行うのですが、結果表示をさせるときにシート2のA列の結果ではなく、シート2のB列の結果を表示させる、ということは可能でしょうか。
>>(B列に地区名が入っていて、知りたいのは重複した名前の人の地区というような・・・
>>dl.Offset(0, 1)を使うとうまくいかなかったもので・・・)
>>
>>何度も申し訳ありません。
>>
>>>▼あやさん：
>>>
>>>まず、このコードは２つの入れ物を使っています。
>>> １つが Dictionary と呼ばれるもの。もう１つがArrayListと呼ばれるものです。
>>>いずれもＶＢＡの持ち物ではなく外部（.Net等）の機能なので、CreateObject で呼び出して使用。
>>>
>>>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>>>Sheet2の名前を格納するのに使っています。山田が何件あろうと１件の山田になります。
>>>
>>>ArrayListは、キー／データという概念はないのですが同じ値を別のものとして格納可能です。
>>>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が３件あれば３件格納されます。
>>>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>>>エラーメッセージで
>>>山田
>>> 佐藤
>>> 山田
>>> 佐藤
>>>とだすより
>>>山田
>>> 山田
>>> 佐藤
>>> 佐藤
>>>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。（これが dl.Sort です）
>>>
>>>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>>>判定ができます。それが　dic.exists(c.Value)　で、このメソッドが返す結果が True なら　
>>> 重複しているということになりますので、それを dl.Add c.Value　でArrayList に登録しています。
>>>
>>>ArrayListに格納した内容は、ＶＢＡからは一挙に取り出せないので、ArrayListと同じ大きさの
>>>ReDim v(0 To dl.Count - 1)　で１次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>>>v(i) = dl(i)　で、データを取り出しておさめています。
>>> （ArrayListのインデックスは 0 から始まっています）
>>>
>>>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>>>集約して１件にして表示するなら、重複情報も ArrayListではなくDictionary に格納して重複をなくす
>>> ことができます。
>>>
>>> 以下でお試しください。
>>>
>>>Sub Test2()
>>>　　Dim dic As Object
>>>　　Dim dl As Object
>>>　　Dim i As Long
>>>　　Dim v As Variant
>>>　　Dim c As Range
>>>　
>>> 　　Set dic = CreateObject("Scripting.Dictionary")
>>>　　Set dl = CreateObject("Scripting.Dictionary")
>>>　
>>> 　　 With Sheets("Sheet2")
>>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>>　　　　　　dic(c.Value) = True
>>>　　　　Next
>>>　　End With
>>>　
>>> 　　 With Sheets("Sheet3")
>>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>>　　　　　　If dic.exists(c.Value) Then dl(c.Value) = True
>>>　　　　Next
>>>　　End With
>>>　
>>> 　　If dl.Count > 0 Then
>>>　　　　MsgBox "以下の重複がありました" & vbLf & Join(dl.keys, vbLf)
>>>　　Else
>>>　　　　MsgBox "重複はありませんでした"
>>>　　End If
>>>　
>>>End Sub


	【76793】Re:シート1とシート2の内容で一致するも...

β - 15/3/12(木) 21:44 -


	引用なし

	パスワード

▼あやさん：

>判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
>それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・

ん？？
そうしてますよ。 c.Offset(,1) として B列の値を重複のいれもの（Dup)にいれてますが？

もしかして Test2 ？
地域表示は Test3 ですけど？


	【76798】Re:シート1とシート2の内容で一致するも...

あや - 15/3/16(月) 19:51 -


	引用なし

	パスワード

▼β さん：
β様に頂いた回答をもとに自分で順々に作成していて、途中でごちゃごちゃになってしまいました。
ひとまず部分一致は考えず、もともと作成していただいたプログラムを利用してB列の結果を表示するには

If dic.exists(c.Value) Then dl(c.Value) = True

をDupを使うとどのように表現すればよいのでしょうか。。。

>▼あやさん：
>
>>判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
>>それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・
>
>ん？？
>そうしてますよ。 c.Offset(,1) として B列の値を重複のいれもの（Dup)にいれてますが？
>
>もしかして Test2 ？
>地域表示は Test3 ですけど？


	【76799】Re:シート1とシート2の内容で一致するも...

あや - 15/3/16(月) 20:22 -


	引用なし

	パスワード

▼β さん：
B列を表示させることができました！
お騒がせしました。

もう一つ質問をさせてください。
照合をSheet2のA列ではなく、B列と
Sheet3のA列とで行うとき以下の変更だけで良いのでしょうか？

With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))

を

With Sheets("Sheet2")
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))

に。
こうすると照合しているものがあるはずなのに、重複していません、と出てしまいます。
Sheet2のB列のところどころに空欄があるのが原因なのでしょうか？
もし空欄が原因ならば、空欄はどうしても出来てしまうので、空欄を飛ばす処理を教えていただきたいです・・・

何度も何度も申し訳ありません。

>β様に頂いた回答をもとに自分で順々に作成していて、途中でごちゃごちゃになってしまいました。
>ひとまず部分一致は考えず、もともと作成していただいたプログラムを利用してB列の結果を表示するには
>
>If dic.exists(c.Value) Then dl(c.Value) = True
>
>をDupを使うとどのように表現すればよいのでしょうか。。。
>
>
>>▼あやさん：
>>
>>>判定をA列同士で行って、結果表示はSheet2の重複した横のB列を表示するというのをdl.Offset(0, 1)以外で思いつかないのですが、何か良い案はないでしょうか・・・
>>>それともdl.Offset(0, 1)を使って表示できるが、私の書き方がミスっているから表示できないのでしょうか・・・
>>
>>ん？？
>>そうしてますよ。 c.Offset(,1) として B列の値を重複のいれもの（Dup)にいれてますが？
>>
>>もしかして Test2 ？
>>地域表示は Test3 ですけど？


	【76800】Re:シート1とシート2の内容で一致するも...

β - 15/3/16(月) 21:42 -


	引用なし

	パスワード

▼あやさん：

>照合をSheet2のA列ではなく、B列と
>Sheet3のA列とで行うとき以下の変更だけで良いのでしょうか？
>
> With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>
>を
>
> With Sheets("Sheet2")
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>
>に。

はい。これでＯＫです。
こちらで、この形にして、Test2、Test3で実行しましたら、重複はすべて表示されました。

原因はわかりませんが、そちらで作成した、現在使っているコードをアップいただけませんか？


	【76801】Re:シート1とシート2の内容で一致するも...

あや - 15/3/17(火) 9:55 -


	引用なし

	パスワード

▼β さん：
以下のような形になっています。
Sheet2のB列には5行ごとに1行何も入っていない行を挟みます。
また、英語で入力されている列と数字で入力されている行があります。

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim Dup As Object
　　'Dim dl As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")
　　'Set dl = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = True
　　　　Next
　　End With

　　 With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then Dup(c.Offset(, 1).Value) = True
　　　　Next
　　End With

　　If Dup.Count > 0 Then
　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub

>▼あやさん：
>
>>照合をSheet2のA列ではなく、B列と
>>Sheet3のA列とで行うとき以下の変更だけで良いのでしょうか？
>>
>> With Sheets("Sheet2")
>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>
>>を
>>
>> With Sheets("Sheet2")
>>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>>
>>に。
>
>はい。これでＯＫです。
>こちらで、この形にして、Test2、Test3で実行しましたら、重複はすべて表示されました。
>
>原因はわかりませんが、そちらで作成した、現在使っているコードをアップいただけませんか？


	【76802】Re:シート1とシート2の内容で一致するも...

β - 15/3/17(火) 11:04 -


	引用なし

	パスワード

▼あやさん：

そちらのコードの、この部分。

　　With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then Dup(c.Offset(, 1).Value) = True
　　　　Next
　　End With

Sheet3 は A列だけですよね。
地域があるのは Sheet2 ですね。

上記コードは Sheet3を処理しているところですから変数 c は、
Sheet3のA列。c.Offset(,1) は Sheet3のB列。ここは空白ですね。
地域は Sheet2　にありますので。

なので、部分一致の　Test3　の形で使ってもらうか　完全一致なら
現在のそちらのコードを、以下のように。（★印の２か所を変更しています）

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim Dup As Object
　　'Dim dl As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")
　　'Set dl = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then Dup(dic(c.Value)) = True　　'★
　　　　Next
　　End With

　　If Dup.Count > 0 Then
　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub


	【76803】Re:シート1とシート2の内容で一致するも...

あや - 15/3/17(火) 13:13 -


	引用なし

	パスワード

▼β さん：
なるほど・・・
因みになのですが、ここをB列又はC列にあれば
とするには、
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>　　　　Next
　　　　　For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>　　　　Next
>　　End With

で良いのでしょうか・・・
一応実行はできていますが・・・

>▼あやさん：
>
>そちらのコードの、この部分。
>
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then Dup(c.Offset(, 1).Value) = True
>　　　　Next
>　　End With
>
>Sheet3 は A列だけですよね。
>地域があるのは Sheet2 ですね。
>
>上記コードは Sheet3を処理しているところですから変数 c は、
>Sheet3のA列。c.Offset(,1) は Sheet3のB列。ここは空白ですね。
>地域は Sheet2　にありますので。
>
>なので、部分一致の　Test3　の形で使ってもらうか　完全一致なら
>現在のそちらのコードを、以下のように。（★印の２か所を変更しています）
>
>Private Sub CommandButton1_Click()
>　　Dim dic As Object
>　　Dim Dup As Object
>　　'Dim dl As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set Dup = CreateObject("Scripting.Dictionary")
>　　'Set dl = CreateObject("Scripting.Dictionary")
>
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then Dup(dic(c.Value)) = True　　'★
>　　　　Next
>　　End With
>
>　　If Dup.Count > 0 Then
>　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>
>
> End Sub


	【76804】Re:シート1とシート2の内容で一致するも...

あや - 15/3/17(火) 13:17 -


	引用なし

	パスワード

▼β さん：
もう一つごめんなさい。
★印で提示していただいたプログラムを実行すると、
”以下の重複があります”
とは出てくるのですが、B列の値を一緒に表示してくれません・・・

>なるほど・・・
>因みになのですが、ここをB列又はC列にあれば
>とするには、
>>　　 With Sheets("Sheet2")
>>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>>　　　　Next
>　　　　　For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))
>>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>>　　　　Next
>>　　End With
>
>で良いのでしょうか・・・
>一応実行はできていますが・・・
>
>>▼あやさん：
>>
>>そちらのコードの、この部分。
>>
>>　　With Sheets("Sheet3")
>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>　　　　　　If dic.exists(c.Value) Then Dup(c.Offset(, 1).Value) = True
>>　　　　Next
>>　　End With
>>
>>Sheet3 は A列だけですよね。
>>地域があるのは Sheet2 ですね。
>>
>>上記コードは Sheet3を処理しているところですから変数 c は、
>>Sheet3のA列。c.Offset(,1) は Sheet3のB列。ここは空白ですね。
>>地域は Sheet2　にありますので。
>>
>>なので、部分一致の　Test3　の形で使ってもらうか　完全一致なら
>>現在のそちらのコードを、以下のように。（★印の２か所を変更しています）
>>
>>Private Sub CommandButton1_Click()
>>　　Dim dic As Object
>>　　Dim Dup As Object
>>　　'Dim dl As Object
>>　　Dim i As Long
>>　　Dim v As Variant
>>　　Dim c As Range
>>
>>　　Set dic = CreateObject("Scripting.Dictionary")
>>　　Set Dup = CreateObject("Scripting.Dictionary")
>>　　'Set dl = CreateObject("Scripting.Dictionary")
>>
>>　　 With Sheets("Sheet2")
>>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>>　　　　Next
>>　　End With
>>
>>　　With Sheets("Sheet3")
>>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>>　　　　　　If dic.exists(c.Value) Then Dup(dic(c.Value)) = True　　'★
>>　　　　Next
>>　　End With
>>
>>　　If Dup.Count > 0 Then
>>　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
>>　　Else
>>　　　　MsgBox "重複はありませんでした"
>>　　End If
>>
>>
>> End Sub


	【76805】Re:シート1とシート2の内容で一致するも...

あや - 15/3/17(火) 13:31 -


	引用なし

	パスワード

▼β さん：
失礼しました！

Sheet3のB列に名前があり、
Sheet2のA列と一致する名前があるか探す。また結果表示させたいのはSheet2のA列の横のB列の地域

です！
ややこしくて申し訳ありません・・・

>▼あやさん：
>
>そちらのコードの、この部分。
>
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then Dup(c.Offset(, 1).Value) = True
>　　　　Next
>　　End With
>
>Sheet3 は A列だけですよね。
>地域があるのは Sheet2 ですね。
>
>上記コードは Sheet3を処理しているところですから変数 c は、
>Sheet3のA列。c.Offset(,1) は Sheet3のB列。ここは空白ですね。
>地域は Sheet2　にありますので。
>
>なので、部分一致の　Test3　の形で使ってもらうか　完全一致なら
>現在のそちらのコードを、以下のように。（★印の２か所を変更しています）
>
>Private Sub CommandButton1_Click()
>　　Dim dic As Object
>　　Dim Dup As Object
>　　'Dim dl As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set Dup = CreateObject("Scripting.Dictionary")
>　　'Set dl = CreateObject("Scripting.Dictionary")
>
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet3")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then Dup(dic(c.Value)) = True　　'★
>　　　　Next
>　　End With
>
>　　If Dup.Count > 0 Then
>　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>
>
> End Sub


	【76806】Re:シート1とシート2の内容で一致するも...

β - 15/3/17(火) 15:18 -


	引用なし

	パスワード

▼あやさん：

Sheet2 の B列にマッチングすべき値、C列にその地域名、Sheet3のA列にマッチング対象の値。
このレイアウトであれば、重複したものの地域が表示されるはずですが？
メッセージが出て、中身がからっぽということで考えられるのは、
Sheet2のB列で重複のあったものの、右隣り、C列がすべて空白だったという場合のみです。

で、追加質問の件、Sheet2のマッングすべき項目列が C列（地域は D列)なら、

　　　　For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))

でＯＫですよ。


	【76809】Re:シート1とシート2の内容で一致するも...

β - 15/3/17(火) 17:14 -


	引用なし

	パスワード

▼あやさん：

>Sheet3のB列に名前があり、
>Sheet2のA列と一致する名前があるか探す。また結果表示させたいのはSheet2のA列の横のB列の地域
>

ふぅ・・・・・

はい、気を取り直して。

それなら

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim Dup As Object
　　'Dim dl As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")
　　'Set dl = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then Dup(dic(c.Value)) = True　　'★
　　　　Next
　　End With

　　If Dup.Count > 0 Then
　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub


	【76815】Re:シート1とシート2の内容で一致するも...

あや - 15/3/18(水) 8:57 -


	引用なし

	パスワード

▼β さん：
ほんとに何度も申し訳ありません・・・
上手く実行できました！
ほんとうに有難うございます。

もう一つご相談なのですが・・・
”一致箇所”というボタンをSheet3上につくって、そのボタンを押すとSheet3上でSheet2と一致したセルの場所に飛ぶ、複数ある場合は”次へ”というボタンまたはEnterキーで次々一致したセルに飛んでいくようなことは可能でしょうか・・・(Ctrl+Fのような機能)
また、一致したセルがあるところの行すべての文字を赤くする、というようなことがしたいのですが・・・

本当に何度も何度も厚かましく申し訳ありません・・
あと少し助けていただきたく思います・・・

>▼あやさん：
>
>Sheet2 の B列にマッチングすべき値、C列にその地域名、Sheet3のA列にマッチング対象の値。
>このレイアウトであれば、重複したものの地域が表示されるはずですが？
>メッセージが出て、中身がからっぽということで考えられるのは、
>Sheet2のB列で重複のあったものの、右隣り、C列がすべて空白だったという場合のみです。
>
>で、追加質問の件、Sheet2のマッングすべき項目列が C列（地域は D列)なら、
>
>　　　　For Each c In .Range("C1", .Range("C" & Rows.Count).End(xlUp))
>
>でＯＫですよ。


	【76816】Re:シート1とシート2の内容で一致するも...

β - 15/3/18(水) 9:09 -


	引用なし

	パスワード

▼あやさん：

>”一致箇所”というボタンをSheet3上につくって、そのボタンを押すとSheet3上でSheet2と一致したセルの場所に飛ぶ、複数ある場合は”次へ”というボタンまたはEnterキーで次々一致したセルに飛んでいくようなことは可能でしょうか・・・(Ctrl+Fのような機能)
>また、一致したセルがあるところの行すべての文字を赤くする、というようなことがしたいのですが・・・

飛ばすセルや赤く塗るセルは Sheet3　と考えていいですか？


	【76817】Re:シート1とシート2の内容で一致するも...

β - 15/3/18(水) 9:20 -


	引用なし

	パスワード

▼あやさん：

とりあえず、重複したSheet3のセルを赤く塗るところまで。
で、>”一致箇所”というボタンはActiveXコマンドボタンですか？
それとも、フォームツールボタンですか？
（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim Dup As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　Dim Red As Range

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value　'★
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　.Columns("B").Interior.ColorIndex = xlNone
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then
　　　　　　　　Dup(dic(c.Value)) = True　　'★
　　　　　　　　If Red Is Nothing Then
　　　　　　　　　　Set Red = c
　　　　　　　　Else
　　　　　　　　　　Set Red = Union(Red, c)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　.Select
　　End With
　　
　　If Dup.Count > 0 Then
　　　　Red.Interior.Color = vbRed
　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub


	【76818】Re:シート1とシート2の内容で一致するも...

β - 15/3/18(水) 9:37 -


	引用なし

	パスワード

▼あやさん：

>（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）

思いなおして。
この処理はSheet3を見ながらの処理になるので、標準モジュールに書きましょう。
で、これをボタン登録してもいいのですが、ボタンがシートの上のほうにあって
検索せるが下のほうにあると、「次へ」の操作で、シートをまた上のほうにスクロールする
必要があり操作が煩雑になります。

なので、マクロにショートカットキーを割り当てて、Ctrl/●　とやったほうが操作しやすいかも。

なお、ボタン（マクロ）は１つでまかないましょう。

Sub TestRed()
　　Dim c As Range
　　With Application.FindFormat.Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End With
　　If ActiveCell.Column <> 2 Then Range("B1").Select
　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　If c Is Nothing Then
　　　　MsgBox "重複セルはありません"
　　Else
　　　　c.Select
　　End If
　　
　　Application.FindFormat.Clear
　　
End Sub


	【76822】Re:シート1とシート2の内容で一致するも...

あや - 15/3/18(水) 18:30 -


	引用なし

	パスワード

▼β さん：
ショートカットキーの割り当てでエラーが出てきてしまいます・・・
以下のようだとだめなのでしょうか。

Sub Test()
　　Application.MacroOptions Macro:="TestRed", ShortcutKey:="j"
End Sub

また、下記のプログラムをそのままコピーして使用させていただきましたが、”重複はありません”と常に表示されてしまいます・・・
画面左側のワークシート選択するところでSheet3を選択し、(General)のところに下記のプログラムを記入すればよいのでしょうか？

Sub TestRed()
　　Dim c As Range
　　With Application.FindFormat.Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End With
　　If ActiveCell.Column <> 2 Then Range("B1").Select
　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　If c Is Nothing Then
　　　　MsgBox "重複セルはありません"
　　Else
　　　　c.Select
　　End If
　
　　Application.FindFormat.Clear
　
End Sub

>▼あやさん：
>
>>（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）
>
>思いなおして。
>この処理はSheet3を見ながらの処理になるので、標準モジュールに書きましょう。
>で、これをボタン登録してもいいのですが、ボタンがシートの上のほうにあって
>検索せるが下のほうにあると、「次へ」の操作で、シートをまた上のほうにスクロールする
>必要があり操作が煩雑になります。
>
>なので、マクロにショートカットキーを割り当てて、Ctrl/●　とやったほうが操作しやすいかも。
>
>なお、ボタン（マクロ）は１つでまかないましょう。
>
>Sub TestRed()
>　　Dim c As Range
>　　With Application.FindFormat.Interior
>　　　　.PatternColorIndex = xlAutomatic
>　　　　.Color = 255
>　　　　.TintAndShade = 0
>　　　　.PatternTintAndShade = 0
>　　End With
>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>　　　　　　MatchByte:=False, SearchFormat:=True)
>　　If c Is Nothing Then
>　　　　MsgBox "重複セルはありません"
>　　Else
>　　　　c.Select
>　　End If
>　　
>　　Application.FindFormat.Clear
>　　
>End Sub


	【76823】Re:シート1とシート2の内容で一致するも...

β - 15/3/18(水) 19:48 -


	引用なし

	パスワード

▼あやさん：

>▼β さん：
>ショートカットキーの割り当てでエラーが出てきてしまいます・・・
>以下のようだとだめなのでしょうか。

こちらで、標準モジュールにコードをコピペして、そのまま実行しましたが
正常に登録されますよ。
不思議ですねぇ。

もちろんコード実行時に標準モジュールに TestRed が書かれているという前提ですが。

あっ、いいわすれてましたが、TestRed は標準モジュールに書きます。

>また、下記のプログラムをそのままコピーして使用させていただきましたが、”重複はありません”と常に表示されてしまいます・・・

↑で書きましたがシートモジュールではなく標準モジュールです。
で、このマクロは、B列の赤色のセルを捜しています。
この赤は、シートモジュールのCommandButton1_Click()　ルーティンで塗られます。
赤に塗られたセルがない場合は、重複がないとみなされます。

この実行は、Sheet3をアクティブにして行われると理解しています。

>画面左側のワークシート選択するところでSheet3を選択し、(General)のところに下記のプログラムを記入すればよいのでしょうか？
>
>Sub TestRed()
>　　Dim c As Range
>　　With Application.FindFormat.Interior
>　　　　.PatternColorIndex = xlAutomatic
>　　　　.Color = 255
>　　　　.TintAndShade = 0
>　　　　.PatternTintAndShade = 0
>　　End With
>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>　　　　　　MatchByte:=False, SearchFormat:=True)
>　　If c Is Nothing Then
>　　　　MsgBox "重複セルはありません"
>　　Else
>　　　　c.Select
>　　End If
>　
>　　Application.FindFormat.Clear
>　
>End Sub
>
>
>>▼あやさん：
>>
>>>（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）
>>
>>思いなおして。
>>この処理はSheet3を見ながらの処理になるので、標準モジュールに書きましょう。
>>で、これをボタン登録してもいいのですが、ボタンがシートの上のほうにあって
>>検索せるが下のほうにあると、「次へ」の操作で、シートをまた上のほうにスクロールする
>>必要があり操作が煩雑になります。
>>
>>なので、マクロにショートカットキーを割り当てて、Ctrl/●　とやったほうが操作しやすいかも。
>>
>>なお、ボタン（マクロ）は１つでまかないましょう。
>>
>>Sub TestRed()
>>　　Dim c As Range
>>　　With Application.FindFormat.Interior
>>　　　　.PatternColorIndex = xlAutomatic
>>　　　　.Color = 255
>>　　　　.TintAndShade = 0
>>　　　　.PatternTintAndShade = 0
>>　　End With
>>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>>　　　　　　MatchByte:=False, SearchFormat:=True)
>>　　If c Is Nothing Then
>>　　　　MsgBox "重複セルはありません"
>>　　Else
>>　　　　c.Select
>>　　End If
>>　　
>>　　Application.FindFormat.Clear
>>　　
>>End Sub


	【76825】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 9:38 -


	引用なし

	パスワード

▼β さん：
標準モジュールに記入することでエラーは消えました！
有難うございます！！
ですがショートカットキーで飛んでくれません・・・
該当のセルは赤く表示されているのに・・・泣

Sub Test()
　　Application.MacroOptions Macro:="TestRed", ShortcutKey:="j"
End Sub

はSheet3上に記入して良いのですよね？
あと、この記述だとCtrl+Jをすると飛ぶということでよいのですよね？？

>▼あやさん：
>
>>▼β さん：
>>ショートカットキーの割り当てでエラーが出てきてしまいます・・・
>>以下のようだとだめなのでしょうか。
>
>こちらで、標準モジュールにコードをコピペして、そのまま実行しましたが
>正常に登録されますよ。
>不思議ですねぇ。
>
>もちろんコード実行時に標準モジュールに TestRed が書かれているという前提ですが。
>
>あっ、いいわすれてましたが、TestRed は標準モジュールに書きます。
>
>>また、下記のプログラムをそのままコピーして使用させていただきましたが、”重複はありません”と常に表示されてしまいます・・・
>
>↑で書きましたがシートモジュールではなく標準モジュールです。
>で、このマクロは、B列の赤色のセルを捜しています。
>この赤は、シートモジュールのCommandButton1_Click()　ルーティンで塗られます。
>赤に塗られたセルがない場合は、重複がないとみなされます。
>
>この実行は、Sheet3をアクティブにして行われると理解しています。
>
>
>>画面左側のワークシート選択するところでSheet3を選択し、(General)のところに下記のプログラムを記入すればよいのでしょうか？
>>
>>Sub TestRed()
>>　　Dim c As Range
>>　　With Application.FindFormat.Interior
>>　　　　.PatternColorIndex = xlAutomatic
>>　　　　.Color = 255
>>　　　　.TintAndShade = 0
>>　　　　.PatternTintAndShade = 0
>>　　End With
>>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>>　　　　　　MatchByte:=False, SearchFormat:=True)
>>　　If c Is Nothing Then
>>　　　　MsgBox "重複セルはありません"
>>　　Else
>>　　　　c.Select
>>　　End If
>>　
>>　　Application.FindFormat.Clear
>>　
>>End Sub
>>
>>
>>>▼あやさん：
>>>
>>>>（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）
>>>
>>>思いなおして。
>>>この処理はSheet3を見ながらの処理になるので、標準モジュールに書きましょう。
>>>で、これをボタン登録してもいいのですが、ボタンがシートの上のほうにあって
>>>検索せるが下のほうにあると、「次へ」の操作で、シートをまた上のほうにスクロールする
>>>必要があり操作が煩雑になります。
>>>
>>>なので、マクロにショートカットキーを割り当てて、Ctrl/●　とやったほうが操作しやすいかも。
>>>
>>>なお、ボタン（マクロ）は１つでまかないましょう。
>>>
>>>Sub TestRed()
>>>　　Dim c As Range
>>>　　With Application.FindFormat.Interior
>>>　　　　.PatternColorIndex = xlAutomatic
>>>　　　　.Color = 255
>>>　　　　.TintAndShade = 0
>>>　　　　.PatternTintAndShade = 0
>>>　　End With
>>>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>>>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>>>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>>>　　　　　　MatchByte:=False, SearchFormat:=True)
>>>　　If c Is Nothing Then
>>>　　　　MsgBox "重複セルはありません"
>>>　　Else
>>>　　　　c.Select
>>>　　End If
>>>　　
>>>　　Application.FindFormat.Clear
>>>　　
>>>End Sub


	【76826】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 10:03 -


	引用なし

	パスワード

▼β さん：
いろいろいじってみたらなぜか途中から上手くいきました・・・
頂いたプログラムはほとんど変更していないのに・・・
とにかく有難うございます！！

因みになのですが・・・
CommandButton1で一致したものを全て表示ではなく、複数一致した場合に最初に一致したものだけ、あるいは最後に一致したものだけを結果表示およびセルを赤く表示したい場合にはどうしたらよいのでしょうか？

>▼あやさん：
>
>>▼β さん：
>>ショートカットキーの割り当てでエラーが出てきてしまいます・・・
>>以下のようだとだめなのでしょうか。
>
>こちらで、標準モジュールにコードをコピペして、そのまま実行しましたが
>正常に登録されますよ。
>不思議ですねぇ。
>
>もちろんコード実行時に標準モジュールに TestRed が書かれているという前提ですが。
>
>あっ、いいわすれてましたが、TestRed は標準モジュールに書きます。
>
>>また、下記のプログラムをそのままコピーして使用させていただきましたが、”重複はありません”と常に表示されてしまいます・・・
>
>↑で書きましたがシートモジュールではなく標準モジュールです。
>で、このマクロは、B列の赤色のセルを捜しています。
>この赤は、シートモジュールのCommandButton1_Click()　ルーティンで塗られます。
>赤に塗られたセルがない場合は、重複がないとみなされます。
>
>この実行は、Sheet3をアクティブにして行われると理解しています。
>
>
>>画面左側のワークシート選択するところでSheet3を選択し、(General)のところに下記のプログラムを記入すればよいのでしょうか？
>>
>>Sub TestRed()
>>　　Dim c As Range
>>　　With Application.FindFormat.Interior
>>　　　　.PatternColorIndex = xlAutomatic
>>　　　　.Color = 255
>>　　　　.TintAndShade = 0
>>　　　　.PatternTintAndShade = 0
>>　　End With
>>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>>　　　　　　MatchByte:=False, SearchFormat:=True)
>>　　If c Is Nothing Then
>>　　　　MsgBox "重複セルはありません"
>>　　Else
>>　　　　c.Select
>>　　End If
>>　
>>　　Application.FindFormat.Clear
>>　
>>End Sub
>>
>>
>>>▼あやさん：
>>>
>>>>（CommandButton1 がActiveXなので、一致箇所もActiveXのほうがいいと思いますが）
>>>
>>>思いなおして。
>>>この処理はSheet3を見ながらの処理になるので、標準モジュールに書きましょう。
>>>で、これをボタン登録してもいいのですが、ボタンがシートの上のほうにあって
>>>検索せるが下のほうにあると、「次へ」の操作で、シートをまた上のほうにスクロールする
>>>必要があり操作が煩雑になります。
>>>
>>>なので、マクロにショートカットキーを割り当てて、Ctrl/●　とやったほうが操作しやすいかも。
>>>
>>>なお、ボタン（マクロ）は１つでまかないましょう。
>>>
>>>Sub TestRed()
>>>　　Dim c As Range
>>>　　With Application.FindFormat.Interior
>>>　　　　.PatternColorIndex = xlAutomatic
>>>　　　　.Color = 255
>>>　　　　.TintAndShade = 0
>>>　　　　.PatternTintAndShade = 0
>>>　　End With
>>>　　If ActiveCell.Column <> 2 Then Range("B1").Select
>>>　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
>>>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>>>　　　　　　MatchByte:=False, SearchFormat:=True)
>>>　　If c Is Nothing Then
>>>　　　　MsgBox "重複セルはありません"
>>>　　Else
>>>　　　　c.Select
>>>　　End If
>>>　　
>>>　　Application.FindFormat.Clear
>>>　　
>>>End Sub


	【76827】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 11:12 -


	引用なし

	パスワード

▼あやさん：

こんにちは

まず、私がアップした TestRed　は標準モジュールに書きますが
そちらのショートカットキー設定のマクロも標準モジュールに書くと想定していました。
コードは、ここにかかなければいけないという、特殊なものを除いては、どこにでもかけます。
ただ、どこにかくとどうなるということを意識して、整合性のあるコードを書く必要があります。
私個人は、基本的には標準モジュールに書く、その他のモジュール（シートモジュール等。
総称してオブジェクトモジュールといいます）には、イベント処理等の部分のみを書く。
こんな方針ですが、特に上級者の皆さんは、基本的にはオブジェクトモジュールに書く、
標準モジュールは共通処理等、コード実行を裏ででささえる補助的なものを書くといわれる人が
少なくありません。

以下のようなページが参考になると思います。

ht p://officetanaka.net/excel/vba/beginner/10.htm
ht p://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200_040.html
ht p://it.g-tec-inc.co.jp/blog/vba/vbe

>複数一致した場合に最初に一致したものだけを結果表示およびセルを赤く表示

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim Dup As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　Dim Red As Range

　　Set dic = CreateObject("Scripting.Dictionary")
　　Set Dup = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　.Columns("B").Interior.ColorIndex = xlNone
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then
　　　　　　　　If Not Dup(dic(c.Value)) Then
　　　　　　　　　　Dup(dic(c.Value)) = True
　　　　　　　　　　If Red Is Nothing Then
　　　　　　　　　　　　Set Red = c
　　　　　　　　　　Else
　　　　　　　　　　　　Set Red = Union(Red, c)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　.Select
　　End With
　　
　　If Dup.Count > 0 Then
　　　　Red.Interior.Color = vbRed
　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub


	【76828】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 15:33 -


	引用なし

	パスワード

▼β さん：
なるほど・・・
参考になりました。
有難うございます。
初心者なもので、どのプログラムをどこに書いたら良いのかが分からず・・・

また複数一致するものがある場合に、最初のものだけ結果表示するという件のプログラム有難うございます。
そのまま使わせていただきましたが、複数結果表示されてしまいます・・・

>▼あやさん：
>
>こんにちは
>
>まず、私がアップした TestRed　は標準モジュールに書きますが
>そちらのショートカットキー設定のマクロも標準モジュールに書くと想定していました。
>コードは、ここにかかなければいけないという、特殊なものを除いては、どこにでもかけます。
>ただ、どこにかくとどうなるということを意識して、整合性のあるコードを書く必要があります。
>私個人は、基本的には標準モジュールに書く、その他のモジュール（シートモジュール等。
>総称してオブジェクトモジュールといいます）には、イベント処理等の部分のみを書く。
>こんな方針ですが、特に上級者の皆さんは、基本的にはオブジェクトモジュールに書く、
>標準モジュールは共通処理等、コード実行を裏ででささえる補助的なものを書くといわれる人が
>少なくありません。
>
>以下のようなページが参考になると思います。
>
>ht p://officetanaka.net/excel/vba/beginner/10.htm
>ht p://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200_040.html
>ht p://it.g-tec-inc.co.jp/blog/vba/vbe
>
>>複数一致した場合に最初に一致したものだけを結果表示およびセルを赤く表示
>
>Private Sub CommandButton1_Click()
>　　Dim dic As Object
>　　Dim Dup As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　Dim Red As Range
>
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set Dup = CreateObject("Scripting.Dictionary")
>
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet3")
>　　　　.Columns("B").Interior.ColorIndex = xlNone
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then
>　　　　　　　　If Not Dup(dic(c.Value)) Then
>　　　　　　　　　　Dup(dic(c.Value)) = True
>　　　　　　　　　　If Red Is Nothing Then
>　　　　　　　　　　　　Set Red = c
>　　　　　　　　　　Else
>　　　　　　　　　　　　Set Red = Union(Red, c)
>　　　　　　　　　　End If
>　　　　　　　　End If
>　　　　　　End If
>　　　　Next
>　　　　.Select
>　　End With
>　　
>　　If Dup.Count > 0 Then
>　　　　Red.Interior.Color = vbRed
>　　　　MsgBox "以下の重複があります" & vbLf & Join(Dup.keys, vbLf)
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>
>
> End Sub


	【76829】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 15:46 -


	引用なし

	パスワード

▼あやさん：

>そのまま使わせていただきましたが、複数結果表示されてしまいます・・・

えっ？？
そうですか？

う～ん・・・悩んでみますが、

Sheet2 これこれのデータがある
Sheet3には　これこれのデータがある
本来は、こうなるべきなのに、こうなってしまった。

もちろん、重複に関するところだけでいいので
具体的な文字列として教えてもらえませんか？


	【76830】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 16:14 -


	引用なし

	パスワード

▼β さん：
具体的な文字列、というのはSheet2とSheet3に何を記入して試しているのか、ということで良いでしょうか。
現在テスト形式でしているので、入れている値は適当です・・・

＊Sheet2
A列　　　　B列
1111　　　　ああああ
22　　　　　いいいい

333　　　　　ううう
4444　　　　　ええええ

＊Sheet3
B列
22
7777
44
4444
3

＊結果表示
以下重複があります
22

4444

というような感じで出てしまいます。

>▼あやさん：
>
>>そのまま使わせていただきましたが、複数結果表示されてしまいます・・・
>
>えっ？？
>そうですか？
>
>う～ん・・・悩んでみますが、
>
>Sheet2 これこれのデータがある
>Sheet3には　これこれのデータがある
>本来は、こうなるべきなのに、こうなってしまった。
>
>もちろん、重複に関するところだけでいいので
>具体的な文字列として教えてもらえませんか？


	【76831】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 16:17 -


	引用なし

	パスワード

▼β さん：
ごめんなさい。結果表示は以下のように出ます。

＊結果表示
以下重複があります
いいいい

ええええ

>▼あやさん：
>
>>そのまま使わせていただきましたが、複数結果表示されてしまいます・・・
>
>えっ？？
>そうですか？
>
>う～ん・・・悩んでみますが、
>
>Sheet2 これこれのデータがある
>Sheet3には　これこれのデータがある
>本来は、こうなるべきなのに、こうなってしまった。
>
>もちろん、重複に関するところだけでいいので
>具体的な文字列として教えてもらえませんか？


	【76834】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 17:28 -


	引用なし

	パスワード

▼あやさん：

重複の件ですが、こうなるべきだというロジックになっています。
つまり、Sheet3 に 22 や 4444 が、もっともっとあった場合、
当初は、そのすべてを表示していたと思いますが、現在は、最初の22、最初の4444 に限定して
メッセージをだす、で、だす際には、その地域であるいいいい　や　ええええ　で出す。
（いいかえれえば、地域で１つしか出さないようにしています）

これを、いいいい　だけにしたいということですか？
つまり、以下の地域に・・・で重複地域をすべて出すのではなく、
いいいい　等の地域に・・・と出して、他に何が重複していたか、
それは目で見て調べてくださいと、こんな処理でいいのですか？


	【76835】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 18:02 -


	引用なし

	パスワード

▼β さん：
そうです！
説明不足でした。失礼いたしました。

複数結果が一致してしまっても、結果自体の表示また、セルを赤くすることを最初に一致したものだけに行う、ということをしたいです。
また可能であれば最後に一致したものだけ表示、セルを赤くする、ということも教えていただきたいです。

あと、複数表示していた時なのですが、セルは複数赤くなっているのですが、ショートカットキーを使って赤くなっているセルの二つ目以降のところに飛ぶにはどうしたらよいのでしょうか。
Ctrl+Jを何回押しても最初のセルにしか飛んでくれないので・・・

>▼あやさん：
>
>重複の件ですが、こうなるべきだというロジックになっています。
>つまり、Sheet3 に 22 や 4444 が、もっともっとあった場合、
>当初は、そのすべてを表示していたと思いますが、現在は、最初の22、最初の4444 に限定して
>メッセージをだす、で、だす際には、その地域であるいいいい　や　ええええ　で出す。
>（いいかえれえば、地域で１つしか出さないようにしています）
>
>これを、いいいい　だけにしたいということですか？
>つまり、以下の地域に・・・で重複地域をすべて出すのではなく、
>いいいい　等の地域に・・・と出して、他に何が重複していたか、
>それは目で見て調べてくださいと、こんな処理でいいのですか？


	【76836】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 18:14 -


	引用なし

	パスワード

▼あやさん：

>複数結果が一致してしまっても、結果自体の表示また、セルを赤くすることを最初に一致したものだけに行う、ということをしたいです。
>また可能であれば最後に一致したものだけ表示、セルを赤くする、ということも教えていただきたいです。

はい。後ほど、最初のもののみバージョンと最後のもののみバージョンをアップします。
ということは、もう TestRedは不要ということですね？
赤セルは１つしかないわけですから。

>あと、複数表示していた時なのですが、セルは複数赤くなっているのですが、ショートカットキーを使って赤くなっているセルの二つ目以降のところに飛ぶにはどうしたらよいのでしょうか。
>Ctrl+Jを何回押しても最初のセルにしか飛んでくれないので・・・

説明しませんでしたが、B列のアクティブセルの「次から」検索しています。
で、Ctrl/j を押したときに　B列以外が選択されていたら B1 にもっていって
そこから検索します。
でも、検索されたセルを選択状態にしますので、そのまま Ctrl/j で、次の赤セルに
とぶはずですが？
もし、検索後、Ｂ列以外を選択してから Ctrl/j をおせば、はじめからになりますが。


	【76837】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 19:07 -


	引用なし

	パスワード

▼あやさん：

１番目が最初の重複のみ表示、２番目が最後の重複のみ表示です。

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　Dim Red As Range
　　Dim Dup As String
　　
　　Set dic = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　.Columns("B").Interior.ColorIndex = xlNone
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then
　　　　　　　　If Red Is Nothing Then
　　　　　　　　　　Set Red = c
　　　　　　　　　　Dup = c.Value
　　　　　　　　　　'もし地域を表示するなら
'　　　　　　　　　　Dup = dic(c.Value)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　.Select
　　End With
　
　　 If Not Red Is Nothing Then
　　　　Red.Interior.Color = vbRed
　　　　MsgBox "重複があります:" & Dup
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub

Private Sub CommandButton1_Click()
　　Dim dic As Object
　　Dim i As Long
　　Dim v As Variant
　　Dim c As Range
　　Dim Red As Range
　　Dim Dup As String
　　
　　Set dic = CreateObject("Scripting.Dictionary")

　　 With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
　　　　　　dic(c.Value) = c.Offset(, 1).Value
　　　　Next
　　End With

　　With Sheets("Sheet3")
　　　　.Columns("B").Interior.ColorIndex = xlNone
　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　　　　　If dic.exists(c.Value) Then
　　　　　　　　Set Red = c
　　　　　　　　Dup = c.Value
　　　　　　　　'もし地域を表示するなら
'　　　　　　　　Dup = dic(c.Value)
　　　　　　End If
　　　　Next
　　　　.Select
　　End With
　
　　 If Not Red Is Nothing Then
　　　　Red.Interior.Color = vbRed
　　　　MsgBox "重複があります:" & Dup
　　Else
　　　　MsgBox "重複はありませんでした"
　　End If

End Sub


	【76838】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 19:15 -


	引用なし

	パスワード

▼β さん：
有難うございます

>>あと、複数表示していた時なのですが、セルは複数赤くなっているのですが、ショートカットキーを使って赤くなっているセルの二つ目以降のところに飛ぶにはどうしたらよいのでしょうか。
>>Ctrl+Jを何回押しても最初のセルにしか飛んでくれないので・・・
>
>説明しませんでしたが、B列のアクティブセルの「次から」検索しています。
>で、Ctrl/j を押したときに　B列以外が選択されていたら B1 にもっていって
>そこから検索します。
>でも、検索されたセルを選択状態にしますので、そのまま Ctrl/j で、次の赤セルに
>とぶはずですが？
>もし、検索後、Ｂ列以外を選択してから Ctrl/j をおせば、はじめからになりますが。
ということは一致箇所があるか検索するボタンを押して、一致箇所があれば、その時点で一致箇所のセルに飛ぶということでしょうか？

一致箇所を探すボタンを押す→OK→Sheet3のどこかのセルを選択→Ctrl+J
をしないと赤のセルのところに飛んでくれません。
また、最初の赤セルにCtrl+Jで飛んでくれるのですが、そのままCtrl+Jを何回押しても最初の赤セルしか選択してくれません

>▼あやさん：
>
>>複数結果が一致してしまっても、結果自体の表示また、セルを赤くすることを最初に一致したものだけに行う、ということをしたいです。
>>また可能であれば最後に一致したものだけ表示、セルを赤くする、ということも教えていただきたいです。
>
>はい。後ほど、最初のもののみバージョンと最後のもののみバージョンをアップします。
>ということは、もう TestRedは不要ということですね？
>赤セルは１つしかないわけですから。
>
>>あと、複数表示していた時なのですが、セルは複数赤くなっているのですが、ショートカットキーを使って赤くなっているセルの二つ目以降のところに飛ぶにはどうしたらよいのでしょうか。
>>Ctrl+Jを何回押しても最初のセルにしか飛んでくれないので・・・
>
>説明しませんでしたが、B列のアクティブセルの「次から」検索しています。
>で、Ctrl/j を押したときに　B列以外が選択されていたら B1 にもっていって
>そこから検索します。
>でも、検索されたセルを選択状態にしますので、そのまま Ctrl/j で、次の赤セルに
>とぶはずですが？
>もし、検索後、Ｂ列以外を選択してから Ctrl/j をおせば、はじめからになりますが。


	【76839】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 19:33 -


	引用なし

	パスワード

▼β さん：
最初のまた最後のだけ結果表示してくれるようになりました
本当にありがとうございます

ところがCtrl+Jをするとエラーが出てきてしまいます
デバックをすると
Set c = Columns("C").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
この部分が選択されます
ここの部分でなにを行っているか教えていただけないでしょうか

>▼あやさん：
>
>１番目が最初の重複のみ表示、２番目が最後の重複のみ表示です。
>
>Private Sub CommandButton1_Click()
>　　Dim dic As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　Dim Red As Range
>　　Dim Dup As String
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet3")
>　　　　.Columns("B").Interior.ColorIndex = xlNone
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then
>　　　　　　　　If Red Is Nothing Then
>　　　　　　　　　　Set Red = c
>　　　　　　　　　　Dup = c.Value
>　　　　　　　　　　'もし地域を表示するなら
>'　　　　　　　　　　Dup = dic(c.Value)
>　　　　　　　　End If
>　　　　　　End If
>　　　　Next
>　　　　.Select
>　　End With
>　
>　　 If Not Red Is Nothing Then
>　　　　Red.Interior.Color = vbRed
>　　　　MsgBox "重複があります:" & Dup
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>
>End Sub
>
>
>Private Sub CommandButton1_Click()
>　　Dim dic As Object
>　　Dim i As Long
>　　Dim v As Variant
>　　Dim c As Range
>　　Dim Red As Range
>　　Dim Dup As String
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>
>　　 With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
>　　　　　　dic(c.Value) = c.Offset(, 1).Value
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet3")
>　　　　.Columns("B").Interior.ColorIndex = xlNone
>　　　　For Each c In .Range("B1", .Range("B" & Rows.Count).End(xlUp))
>　　　　　　If dic.exists(c.Value) Then
>　　　　　　　　Set Red = c
>　　　　　　　　Dup = c.Value
>　　　　　　　　'もし地域を表示するなら
>'　　　　　　　　Dup = dic(c.Value)
>　　　　　　End If
>　　　　Next
>　　　　.Select
>　　End With
>　
>　　 If Not Red Is Nothing Then
>　　　　Red.Interior.Color = vbRed
>　　　　MsgBox "重複があります:" & Dup
>　　Else
>　　　　MsgBox "重複はありませんでした"
>　　End If
>
> End Sub


	【76840】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 19:50 -


	引用なし

	パスワード

▼あやさん：

>最初のまた最後のだけ結果表示してくれるようになりました

よかったです。

>ところがCtrl+Jをするとエラーが出てきてしまいます

まず、Sheet3 を表示して操作してますよね？
で、その前提で。

私がアップしたものは　Columns("B").Find でしたよね。

> Set c = Columns("C").Find(What:="", After:=ActiveCell,

なぜ、C列なんですか？
C列には色は塗っていませんが？


	【76841】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 20:04 -


	引用なし

	パスワード

▼β さん：
>まず、Sheet3 を表示して操作してますよね？
>で、その前提で。
表示しています

>私がアップしたものは　Columns("B").Find でしたよね。
>
>
>> Set c = Columns("C").Find(What:="", After:=ActiveCell,
>
>なぜ、C列なんですか？
>C列には色は塗っていませんが？
ごめんなさい。プログラムを理解したくどこを変更するとどう変わるのか試していたやつを送っていました

追加追加でごめんなさい
因みに赤セルをB列以外に設定した場合このプログラムだとどこを変更しないといけないのでしょうか
'◆をつけたところ以外に変更点はありますか(C列に変更してみてます)
Sub Test()
　　Application.MacroOptions Macro:="TestRed", ShortcutKey:="z"
End Sub

Sub TestRed()
　　Dim c As Range
　　With Application.FindFormat.Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End With
　　If ActiveCell.Column <> 2 Then Range("C1").Select　'◆
　　Set c = Columns("C").Find(What:="", After:=ActiveCell,　'◆ LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　If c Is Nothing Then
　　　　MsgBox "重複セルはありません"
　　Else
　　　　c.Select
　　End If
　
　　Application.FindFormat.Clear
　
End Sub

>▼あやさん：
>
>>最初のまた最後のだけ結果表示してくれるようになりました
>
>よかったです。
>
>>ところがCtrl+Jをするとエラーが出てきてしまいます
>
>まず、Sheet3 を表示して操作してますよね？
>で、その前提で。
>
>私がアップしたものは　Columns("B").Find でしたよね。
>
>
>> Set c = Columns("C").Find(What:="", After:=ActiveCell,
>
>なぜ、C列なんですか？
>C列には色は塗っていませんが？


	【76842】Re:シート1とシート2の内容で一致するも...

あや - 15/3/19(木) 20:11 -


	引用なし

	パスワード

▼β さん：
ごめんなさい！
少しいじったら上手くいきました！
有難うございます。

列を変更したときもできました
勉強不足過ぎました
大変ご迷惑おかけしました・・・

>▼β さん：
>>まず、Sheet3 を表示して操作してますよね？
>>で、その前提で。
>表示しています
>
>>私がアップしたものは　Columns("B").Find でしたよね。
>>
>>
>>> Set c = Columns("C").Find(What:="", After:=ActiveCell,
>>
>>なぜ、C列なんですか？
>>C列には色は塗っていませんが？
>ごめんなさい。プログラムを理解したくどこを変更するとどう変わるのか試していたやつを送っていました
>
>追加追加でごめんなさい
>因みに赤セルをB列以外に設定した場合このプログラムだとどこを変更しないといけないのでしょうか
>'◆をつけたところ以外に変更点はありますか(C列に変更してみてます)
>Sub Test()
>　　Application.MacroOptions Macro:="TestRed", ShortcutKey:="z"
>End Sub
>
>Sub TestRed()
>　　Dim c As Range
>　　With Application.FindFormat.Interior
>　　　　.PatternColorIndex = xlAutomatic
>　　　　.Color = 255
>　　　　.TintAndShade = 0
>　　　　.PatternTintAndShade = 0
>　　End With
>　　If ActiveCell.Column <> 2 Then Range("C1").Select　'◆
>　　Set c = Columns("C").Find(What:="", After:=ActiveCell,　'◆ LookIn:=xlFormulas, LookAt:=xlPart, _
>　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
>　　　　　　MatchByte:=False, SearchFormat:=True)
>　　If c Is Nothing Then
>　　　　MsgBox "重複セルはありません"
>　　Else
>　　　　c.Select
>　　End If
>　
>　　Application.FindFormat.Clear
>　
>End Sub
>
>
>>▼あやさん：
>>
>>>最初のまた最後のだけ結果表示してくれるようになりました
>>
>>よかったです。
>>
>>>ところがCtrl+Jをするとエラーが出てきてしまいます
>>
>>まず、Sheet3 を表示して操作してますよね？
>>で、その前提で。
>>
>>私がアップしたものは　Columns("B").Find でしたよね。
>>
>>
>>> Set c = Columns("C").Find(What:="", After:=ActiveCell,
>>
>>なぜ、C列なんですか？
>>C列には色は塗っていませんが？


	【76843】Re:シート1とシート2の内容で一致するも...

β - 15/3/19(木) 20:14 -


	引用なし

	パスワード

▼あやさん：

>ここの部分でなにを行っているか教えていただけないでしょうか

この質問を見落としていました。
シート上の操作で検索をやられたことはあると思いますが、書式検索はやった経験がありますか？
検索文字列を指定する以外に、オプションで、書式（背景色等々）の検索もできます。
で、コードは、この機能を使っています。つまり、文字を探しに行くのではなく背景色の赤を捜しに行きます。

で、なぜエラーかといいますと（想像ですけど）元々 B 列だったのをそちらで（なぜか）C列にかえてますね。

で、検索領域が C列で、そのなかで、どこから探しに行くかを ActiveCell にしています。
この、どこからさがすか、その起点セルは検索領域の中にないとエラーになります。
なので、コードの上のほうで、ActiveCellが B列ではなかったらB1 に飛ばしています。

なので、検索起点が検索領域にないよというエラーになっているものと思います。

今回、赤は１つしかない、とうことは次へというものがない。
ならば、このどこからという起点を記述しないという方法もあります。
つまり、After:=ActiveCell これをカット。
そうすれば、常に、検索領域の最初のセルから検索を行います。

というより、この Ctrl/j の目的は、重複があったね、それはどこだったんだろうと、
そういったことですよね。

であれば、このTestRedは廃止して、CommandButton1ルーティンの最後に、そのセルに飛ばすようにしてはいかが？

MsgBox "重複があります:" & Dup

この後に

Application.GoTo Red

こうして試してみてください。


	【76845】Re:シート1とシート2の内容で一致するも...

あや - 15/3/23(月) 10:42 -


	引用なし

	パスワード

▼β さん：
参考になりました。
有難うございます。

今回実際に使用する際にSheet3のA列と一致するか探しに行くコマンドとSheet3のB列と一致するか探しに行くコマンドを設ける予定なのですが、下記のようにするとA列に赤セルがある場合はショートカットキーで探しに行ってくれますが、B列に赤セルがあっても”重複セルはありません”となってしまいます。
また◆のところをElseIfにしたらエラーがでてきます。
どのようにしたら良いのでしょうか

Sub TestRed()
　　Dim c As Range
　　With Application.FindFormat.Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End With
　　
　　If ActiveCell.Column <> 2 Then Range("B1").Select
　　Set c = Columns("B").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　　　　　
　　If ActiveCell.Column <> 1 Then Range("A1").Select　'◆
　　Set c = Columns("A").Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　　　　　
　　If c Is Nothing Then
　　　　MsgBox "重複セルはありません"
　　Else
　　　　c.Select
　　End If

　　Application.FindFormat.Clear

End Sub

>▼あやさん：
>
>>ここの部分でなにを行っているか教えていただけないでしょうか
>
>この質問を見落としていました。
>シート上の操作で検索をやられたことはあると思いますが、書式検索はやった経験がありますか？
>検索文字列を指定する以外に、オプションで、書式（背景色等々）の検索もできます。
>で、コードは、この機能を使っています。つまり、文字を探しに行くのではなく背景色の赤を捜しに行きます。
>
>で、なぜエラーかといいますと（想像ですけど）元々 B 列だったのをそちらで（なぜか）C列にかえてますね。
>
>で、検索領域が C列で、そのなかで、どこから探しに行くかを ActiveCell にしています。
>この、どこからさがすか、その起点セルは検索領域の中にないとエラーになります。
>なので、コードの上のほうで、ActiveCellが B列ではなかったらB1 に飛ばしています。
>
>なので、検索起点が検索領域にないよというエラーになっているものと思います。
>
>今回、赤は１つしかない、とうことは次へというものがない。
>ならば、このどこからという起点を記述しないという方法もあります。
>つまり、After:=ActiveCell これをカット。
>そうすれば、常に、検索領域の最初のセルから検索を行います。
>
>というより、この Ctrl/j の目的は、重複があったね、それはどこだったんだろうと、
>そういったことですよね。
>
>であれば、このTestRedは廃止して、CommandButton1ルーティンの最後に、そのセルに飛ばすようにしてはいかが？
>
>MsgBox "重複があります:" & Dup
>
>この後に
>
>Application.GoTo Red
>
>こうして試してみてください。


	【76846】Re:シート1とシート2の内容で一致するも...

β - 15/3/23(月) 19:26 -


	引用なし

	パスワード

▼あやさん：

要件を取り違えているかもしれませんが、こういうことですか？

Sub TestRed()
　　Dim c As Range
　　With Application.FindFormat.Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 255
　　　　.TintAndShade = 0
　　　　.PatternTintAndShade = 0
　　End With
　
　　If ActiveCell.Column <> 1 And ActiveCell.Column <> 2 Then Range("B1").Select
　　
　　Set c = Range("A1", ActiveSheet.UsedRange).Columns("A:B").Find(What:="", After:=ActiveCell, _
　　　　　　LookIn:=xlFormulas, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
　　　　　　MatchByte:=False, SearchFormat:=True)
　　
　　If c Is Nothing Then
　　　　MsgBox "重複セルはありません"
　　Else
　　　　c.Select
　　End If

　　Application.FindFormat.Clear

End Sub


	【76849】Re:シート1とシート2の内容で一致するも...

あや - 15/3/24(火) 10:11 -


	引用なし

	パスワード

▼β さん：
うまくいきました！
有難うございます。

ごめんなさい。別件で質問なのですが、Sheet1のA列に大文字で”AAA”という文字列があるか探し、あればそのセルを赤くし、結果表示もさせる、というようなものを作りたいのですが、下記のものだとエラーが出てしまいます。
解決方法を教えていただけないでしょうか。

Private Sub AAA_Click()
　　Dim oRange As Range
　　Dim c As Range

　　Set oRange = Cells.Find(What:="*AAA*" _
　　　　　　　　　　　　　, After:=ActiveCell _
　　　　　　　　　　　　　, LookIn:=xlFormulas _
　　　　　　　　　　　　　, LookAt:=xlWhole _
　　　　　　　　　　　　　, SearchOrder:=xlByRows _
　　　　　　　　　　　　　, SearchDirection:=xlNext _
　　　　　　　　　　　　　, MatchCase:=False _
　　　　　　　　　　　　　, MatchByte:=False _
　　　　　　　　　　　　　, SearchFormat:=False)
　　
　
　　Set c = Selection
　　c.ColorIndex = vbRed　
　　
　　If c.Count > 0 Then　
　　　　MsgBox "AAAがありました"
　　Else
　　　　MsgBox "AAAはありませんでした"
　　End If
　　
End Sub

>▼あやさん：
>
>要件を取り違えているかもしれませんが、こういうことですか？
>
>Sub TestRed()
>　　Dim c As Range
>　　With Application.FindFormat.Interior
>　　　　.PatternColorIndex = xlAutomatic
>　　　　.Color = 255
>　　　　.TintAndShade = 0
>　　　　.PatternTintAndShade = 0
>　　End With
>　
>　　If ActiveCell.Column <> 1 And ActiveCell.Column <> 2 Then Range("B1").Select
>　　
>　　Set c = Range("A1", ActiveSheet.UsedRange).Columns("A:B").Find(What:="", After:=ActiveCell, _
>　　　　　　LookIn:=xlFormulas, LookAt:=xlPart, _
>　　　　　　SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, _
>　　　　　　MatchByte:=False, SearchFormat:=True)
>　　
>　　If c Is Nothing Then
>　　　　MsgBox "重複セルはありません"
>　　Else
>　　　　c.Select
>　　End If
>
>　　Application.FindFormat.Clear
>
> End Sub


	【76851】Re:シート1とシート2の内容で一致するも...

β - 15/3/24(火) 13:36 -


	引用なし

	パスワード

▼あやさん：

こんにちは

アップされたコードにはいくつか（たくさん？）問題があります。

１．領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
　　シート全体の領域になりますから、Ａ列以外にあってもマッチします。
２．で、After は、その領域内の検索開始セルですが、領域が Cellsなら
　　ActivesCell は当然シート内ですからＯＫですが、領域をA列にすると
　　もし、A列以外が選択されている状態ならエラーになります。
　　指定するならＡ列内のセル（A1 とか）か、あるいは指定しない（こちらを推奨）
　　指定がなければ指定領域の先頭のセルから　とみなしてくれますので。
３．「大文字の」という条件ですよね。
　　ところが、MatchCase:=False　。これは大文字／小文字を区別しないという意味です。
　　MatchCase:=True とする必要があります。
４．Findメソッドを実行すると、検索が成功（マッチ）した場合は、そのセルオブジェクトが
　　返されますが、失敗（アンマッチ）した場合は「Nothing」になります。
　　この「Nothing」になっているオブジェクトは、参照できません。
　　参照しようとするとエラーになります。（参照できないので Select もできません）
５．そのFIndメソッドの結果を受ける変数を　oRange　としていますが、この　oRange　は
　　どこでも参照していません。かわりに　Set c = Selection　とした結果の c を参照。
　　きっと　領域.Find(条件).Select として、その　Selectされたセル（Selection)を
　　使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select　は
　　使ってはいけない構文です。（だから使っていないんですよね）
６．c という　セルオブジェクトのプロパティに ColorIndex というものはありません。
　　あるのは、Interior （ほかにもたくさんありますが）
　　で、ColorIndex は、Interior のプロパティです。
　　ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
７．さらに、その ColorIndex ですが、これは 1～56。（その他に塗りつぶしなしの xlNone もありますが）
　　で、これで指定するなら、ColorIndex = 3 です。
　　一方、vbRed はインデックスではなく「色番号」で、実態は 255 です。
　　ColorIndex に 255 を与えると、実行時エラーになります。
　　vbRed で指定するなら Color = vbRed になります。

これらを加味してたとえば

Private Sub AAA_Click()
　　Dim c As Range

　　Set c = Columns("A").Find(What:="*AAA*" _
　　　　　　　　　　　　　, LookIn:=xlFormulas _
　　　　　　　　　　　　　, LookAt:=xlWhole _
　　　　　　　　　　　　　, SearchOrder:=xlByRows _
　　　　　　　　　　　　　, SearchDirection:=xlNext _
　　　　　　　　　　　　　, MatchCase:=True _
　　　　　　　　　　　　　, MatchByte:=False _
　　　　　　　　　　　　　, SearchFormat:=False)
　
　
　 If c Is Nothing Then
　　　　MsgBox "AAAはありませんでした"
　 Else
　　　　c.Interior.Color = vbRed
　　　　MsgBox "AAAがありました"
　 End If
　
End Sub


	【77107】Re:シート1とシート2の内容で一致するも...

あや - 15/5/22(金) 9:38 -


	引用なし

	パスワード

▼β さん：
お久しぶりです。
下記の回答ありがとうございました。
お礼が遅くなり申し訳ありません。

今回またで申し訳ありませんが、質問をさせてください。
以前作っていただいたコードは一致している文字列を探し、一致しているものがあればそのセルを赤くし、別sheetの一致した文字列の隣の列のセルを結果として表示する、というものでしたが、今回その一致条件を探す前に、無いものを探す、ということを行いたいです。

例えばですが、Sheet4のA列にいろいろと文字列を入れておき、Sheet4のA列に入力している文字列が一致検索で探していたところと同じところに1つでも一致しないものがあれば、Shhet4のA列で一致しなかったものの隣のB列の結果を表示する、
というふうに処理がしたいのですが・・・

一致しているものを探す、の逆で一致していないものを探す、なので一致しているものを探すコードを利用して、無いものを探すコードに変えられれば
・・・と思い試行錯誤しているのですが、～がなければというコードをつくるのが上手くいきません・・・

処理としては、Sheet4のA列に書いてある文字列がSheet2のA列に無いものがないか調べる
→全て一致していることを確認できたら：以前作成した一致するものをさがす処理をする
→もし一つでもないものが見つかれば：Sheet4の見つからなかったものの隣のB列に書いてあることを結果として表示する

どうか教えていただけないでしょうか。

>▼あやさん：
>
>こんにちは
>
>アップされたコードにはいくつか（たくさん？）問題があります。
>
>１．領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>　　シート全体の領域になりますから、Ａ列以外にあってもマッチします。
>２．で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>　　ActivesCell は当然シート内ですからＯＫですが、領域をA列にすると
>　　もし、A列以外が選択されている状態ならエラーになります。
>　　指定するならＡ列内のセル（A1 とか）か、あるいは指定しない（こちらを推奨）
>　　指定がなければ指定領域の先頭のセルから　とみなしてくれますので。
>３．「大文字の」という条件ですよね。
>　　ところが、MatchCase:=False　。これは大文字／小文字を区別しないという意味です。
>　　MatchCase:=True とする必要があります。
>４．Findメソッドを実行すると、検索が成功（マッチ）した場合は、そのセルオブジェクトが
>　　返されますが、失敗（アンマッチ）した場合は「Nothing」になります。
>　　この「Nothing」になっているオブジェクトは、参照できません。
>　　参照しようとするとエラーになります。（参照できないので Select もできません）
>５．そのFIndメソッドの結果を受ける変数を　oRange　としていますが、この　oRange　は
>　　どこでも参照していません。かわりに　Set c = Selection　とした結果の c を参照。
>　　きっと　領域.Find(条件).Select として、その　Selectされたセル（Selection)を
>　　使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select　は
>　　使ってはいけない構文です。（だから使っていないんですよね）
>６．c という　セルオブジェクトのプロパティに ColorIndex というものはありません。
>　　あるのは、Interior （ほかにもたくさんありますが）
>　　で、ColorIndex は、Interior のプロパティです。
>　　ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>７．さらに、その ColorIndex ですが、これは 1～56。（その他に塗りつぶしなしの xlNone もありますが）
>　　で、これで指定するなら、ColorIndex = 3 です。
>　　一方、vbRed はインデックスではなく「色番号」で、実態は 255 です。
>　　ColorIndex に 255 を与えると、実行時エラーになります。
>　　vbRed で指定するなら Color = vbRed になります。
>
>これらを加味してたとえば
>
>Private Sub AAA_Click()
>　　Dim c As Range
>
>　　Set c = Columns("A").Find(What:="*AAA*" _
>　　　　　　　　　　　　　, LookIn:=xlFormulas _
>　　　　　　　　　　　　　, LookAt:=xlWhole _
>　　　　　　　　　　　　　, SearchOrder:=xlByRows _
>　　　　　　　　　　　　　, SearchDirection:=xlNext _
>　　　　　　　　　　　　　, MatchCase:=True _
>　　　　　　　　　　　　　, MatchByte:=False _
>　　　　　　　　　　　　　, SearchFormat:=False)
>　
>　
>　 If c Is Nothing Then
>　　　　MsgBox "AAAはありませんでした"
>　 Else
>　　　　c.Interior.Color = vbRed
>　　　　MsgBox "AAAがありました"
>　 End If
>　
>End Sub


	【77110】Re:シート1とシート2の内容で一致するも...

β - 15/5/22(金) 13:23 -


	引用なし

	パスワード

▼あやさん：

思い出すのに、少し時間くださいね。


	【77111】Re:シート1とシート2の内容で一致するも...

β - 15/5/22(金) 14:41 -


	引用なし

	パスワード

▼あやさん：

よく考えますと、あやさんも言っている通り、今までのコードで検索を行っており
その中で見つかった場合、見つからなかった場合の条件判定をしているのですから
とくにわからないところはないのでは？　と思います。
具体的に、どこがわからないのかな？

以下は、あくまでサンプルです。
新規ブックのSheet1のA列にA1から適当な文字列をいれ
またSheet4のA列にA1から、これまた適当な文字列をいれて
以下実行してみてください。
Sheet4のB列に、見つかった、見つからない　の判定を記載します・

基本、これ以上でもこれ以下でもないと思いますので
これを参考に、対処できませんか？

やはり壁があればSOSください。

Sub Sample()
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　
　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　　
　　With Sheets("Sheet4")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　　　c.Offset(, 1).Value = "見つかりません"
　　　　　　Else
　　　　　　　　c.Offset(, 1).Value = "見つかりました"
　　　　　　End If
　　　　Next
　　End With
End Sub
>▼β さん：
>お久しぶりです。
>下記の回答ありがとうございました。
>お礼が遅くなり申し訳ありません。
>
>今回またで申し訳ありませんが、質問をさせてください。
>以前作っていただいたコードは一致している文字列を探し、一致しているものがあればそのセルを赤くし、別sheetの一致した文字列の隣の列のセルを結果として表示する、というものでしたが、今回その一致条件を探す前に、無いものを探す、ということを行いたいです。
>
>例えばですが、Sheet4のA列にいろいろと文字列を入れておき、Sheet4のA列に入力している文字列が一致検索で探していたところと同じところに1つでも一致しないものがあれば、Shhet4のA列で一致しなかったものの隣のB列の結果を表示する、
>というふうに処理がしたいのですが・・・
>
>一致しているものを探す、の逆で一致していないものを探す、なので一致しているものを探すコードを利用して、無いものを探すコードに変えられれば
>・・・と思い試行錯誤しているのですが、～がなければというコードをつくるのが上手くいきません・・・
>
>処理としては、Sheet4のA列に書いてある文字列がSheet2のA列に無いものがないか調べる
>→全て一致していることを確認できたら：以前作成した一致するものをさがす処理をする
>→もし一つでもないものが見つかれば：Sheet4の見つからなかったものの隣のB列に書いてあることを結果として表示する
>
>どうか教えていただけないでしょうか。
>
>>▼あやさん：
>>
>>こんにちは
>>
>>アップされたコードにはいくつか（たくさん？）問題があります。
>>
>>１．領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>>　　シート全体の領域になりますから、Ａ列以外にあってもマッチします。
>>２．で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>>　　ActivesCell は当然シート内ですからＯＫですが、領域をA列にすると
>>　　もし、A列以外が選択されている状態ならエラーになります。
>>　　指定するならＡ列内のセル（A1 とか）か、あるいは指定しない（こちらを推奨）
>>　　指定がなければ指定領域の先頭のセルから　とみなしてくれますので。
>>３．「大文字の」という条件ですよね。
>>　　ところが、MatchCase:=False　。これは大文字／小文字を区別しないという意味です。
>>　　MatchCase:=True とする必要があります。
>>４．Findメソッドを実行すると、検索が成功（マッチ）した場合は、そのセルオブジェクトが
>>　　返されますが、失敗（アンマッチ）した場合は「Nothing」になります。
>>　　この「Nothing」になっているオブジェクトは、参照できません。
>>　　参照しようとするとエラーになります。（参照できないので Select もできません）
>>５．そのFIndメソッドの結果を受ける変数を　oRange　としていますが、この　oRange　は
>>　　どこでも参照していません。かわりに　Set c = Selection　とした結果の c を参照。
>>　　きっと　領域.Find(条件).Select として、その　Selectされたセル（Selection)を
>>　　使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select　は
>>　　使ってはいけない構文です。（だから使っていないんですよね）
>>６．c という　セルオブジェクトのプロパティに ColorIndex というものはありません。
>>　　あるのは、Interior （ほかにもたくさんありますが）
>>　　で、ColorIndex は、Interior のプロパティです。
>>　　ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>>７．さらに、その ColorIndex ですが、これは 1～56。（その他に塗りつぶしなしの xlNone もありますが）
>>　　で、これで指定するなら、ColorIndex = 3 です。
>>　　一方、vbRed はインデックスではなく「色番号」で、実態は 255 です。
>>　　ColorIndex に 255 を与えると、実行時エラーになります。
>>　　vbRed で指定するなら Color = vbRed になります。
>>
>>これらを加味してたとえば
>>
>>Private Sub AAA_Click()
>>　　Dim c As Range
>>
>>　　Set c = Columns("A").Find(What:="*AAA*" _
>>　　　　　　　　　　　　　, LookIn:=xlFormulas _
>>　　　　　　　　　　　　　, LookAt:=xlWhole _
>>　　　　　　　　　　　　　, SearchOrder:=xlByRows _
>>　　　　　　　　　　　　　, SearchDirection:=xlNext _
>>　　　　　　　　　　　　　, MatchCase:=True _
>>　　　　　　　　　　　　　, MatchByte:=False _
>>　　　　　　　　　　　　　, SearchFormat:=False)
>>　
>>　
>>　 If c Is Nothing Then
>>　　　　MsgBox "AAAはありませんでした"
>>　 Else
>>　　　　c.Interior.Color = vbRed
>>　　　　MsgBox "AAAがありました"
>>　 End If
>>　
>>End Sub


	【77112】Re:シート1とシート2の内容で一致するも...

あや - 15/5/22(金) 15:35 -


	引用なし

	パスワード

▼β さん：
たとえばなのですが、Sheet1のA列に以下のように入力されていて、Sheet4のA列、B列に以下のように入力されていました

＊Shhet1
いちご
りんご
ぶどう
みかん
めろん

＊Sheet4
いちご　　赤
りんご　　赤
ぶどう　　紫
みかん　　オレンジ
めろん　　緑
もも　　　ピンク
ばなな　　黄

このときSheet1のなかに”もも”と”ばなな”がありません。
で、一致しなかったこの二つのB列の”ピンク”と”黄”というのを結果で表示したいです。

頭が固いもので、一致条件でつくっていたコードをどう変更すれば一致しなかったものを表示するようにできるかと・・・
今までのは一致したものをカウントし、結果表示させましたが、逆に一致しなかったものをカウントさせ、それを結果表示させる、という展開がうまくいきません・・・

>▼あやさん：
>
>よく考えますと、あやさんも言っている通り、今までのコードで検索を行っており
>その中で見つかった場合、見つからなかった場合の条件判定をしているのですから
>とくにわからないところはないのでは？　と思います。
>具体的に、どこがわからないのかな？
>
>以下は、あくまでサンプルです。
>新規ブックのSheet1のA列にA1から適当な文字列をいれ
>またSheet4のA列にA1から、これまた適当な文字列をいれて
>以下実行してみてください。
>Sheet4のB列に、見つかった、見つからない　の判定を記載します・
>
>基本、これ以上でもこれ以下でもないと思いますので
>これを参考に、対処できませんか？
>
>やはり壁があればSOSください。
>
>Sub Sample()
>　　Dim r As Range
>　　Dim c As Range
>　　Dim f As Range
>　　
>　　With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>　　
>　　With Sheets("Sheet4")
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　c.Offset(, 1).Value = "見つかりません"
>　　　　　　Else
>　　　　　　　　c.Offset(, 1).Value = "見つかりました"
>　　　　　　End If
>　　　　Next
>　　End With
>End Sub
>>▼β さん：
>>お久しぶりです。
>>下記の回答ありがとうございました。
>>お礼が遅くなり申し訳ありません。
>>
>>今回またで申し訳ありませんが、質問をさせてください。
>>以前作っていただいたコードは一致している文字列を探し、一致しているものがあればそのセルを赤くし、別sheetの一致した文字列の隣の列のセルを結果として表示する、というものでしたが、今回その一致条件を探す前に、無いものを探す、ということを行いたいです。
>>
>>例えばですが、Sheet4のA列にいろいろと文字列を入れておき、Sheet4のA列に入力している文字列が一致検索で探していたところと同じところに1つでも一致しないものがあれば、Shhet4のA列で一致しなかったものの隣のB列の結果を表示する、
>>というふうに処理がしたいのですが・・・
>>
>>一致しているものを探す、の逆で一致していないものを探す、なので一致しているものを探すコードを利用して、無いものを探すコードに変えられれば
>>・・・と思い試行錯誤しているのですが、～がなければというコードをつくるのが上手くいきません・・・
>>
>>処理としては、Sheet4のA列に書いてある文字列がSheet2のA列に無いものがないか調べる
>>→全て一致していることを確認できたら：以前作成した一致するものをさがす処理をする
>>→もし一つでもないものが見つかれば：Sheet4の見つからなかったものの隣のB列に書いてあることを結果として表示する
>>
>>どうか教えていただけないでしょうか。
>>
>>>▼あやさん：
>>>
>>>こんにちは
>>>
>>>アップされたコードにはいくつか（たくさん？）問題があります。
>>>
>>>１．領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>>>　　シート全体の領域になりますから、Ａ列以外にあってもマッチします。
>>>２．で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>>>　　ActivesCell は当然シート内ですからＯＫですが、領域をA列にすると
>>>　　もし、A列以外が選択されている状態ならエラーになります。
>>>　　指定するならＡ列内のセル（A1 とか）か、あるいは指定しない（こちらを推奨）
>>>　　指定がなければ指定領域の先頭のセルから　とみなしてくれますので。
>>>３．「大文字の」という条件ですよね。
>>>　　ところが、MatchCase:=False　。これは大文字／小文字を区別しないという意味です。
>>>　　MatchCase:=True とする必要があります。
>>>４．Findメソッドを実行すると、検索が成功（マッチ）した場合は、そのセルオブジェクトが
>>>　　返されますが、失敗（アンマッチ）した場合は「Nothing」になります。
>>>　　この「Nothing」になっているオブジェクトは、参照できません。
>>>　　参照しようとするとエラーになります。（参照できないので Select もできません）
>>>５．そのFIndメソッドの結果を受ける変数を　oRange　としていますが、この　oRange　は
>>>　　どこでも参照していません。かわりに　Set c = Selection　とした結果の c を参照。
>>>　　きっと　領域.Find(条件).Select として、その　Selectされたセル（Selection)を
>>>　　使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select　は
>>>　　使ってはいけない構文です。（だから使っていないんですよね）
>>>６．c という　セルオブジェクトのプロパティに ColorIndex というものはありません。
>>>　　あるのは、Interior （ほかにもたくさんありますが）
>>>　　で、ColorIndex は、Interior のプロパティです。
>>>　　ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>>>７．さらに、その ColorIndex ですが、これは 1～56。（その他に塗りつぶしなしの xlNone もありますが）
>>>　　で、これで指定するなら、ColorIndex = 3 です。
>>>　　一方、vbRed はインデックスではなく「色番号」で、実態は 255 です。
>>>　　ColorIndex に 255 を与えると、実行時エラーになります。
>>>　　vbRed で指定するなら Color = vbRed になります。
>>>
>>>これらを加味してたとえば
>>>
>>>Private Sub AAA_Click()
>>>　　Dim c As Range
>>>
>>>　　Set c = Columns("A").Find(What:="*AAA*" _
>>>　　　　　　　　　　　　　, LookIn:=xlFormulas _
>>>　　　　　　　　　　　　　, LookAt:=xlWhole _
>>>　　　　　　　　　　　　　, SearchOrder:=xlByRows _
>>>　　　　　　　　　　　　　, SearchDirection:=xlNext _
>>>　　　　　　　　　　　　　, MatchCase:=True _
>>>　　　　　　　　　　　　　, MatchByte:=False _
>>>　　　　　　　　　　　　　, SearchFormat:=False)
>>>　
>>>　
>>>　 If c Is Nothing Then
>>>　　　　MsgBox "AAAはありませんでした"
>>>　 Else
>>>　　　　c.Interior.Color = vbRed
>>>　　　　MsgBox "AAAがありました"
>>>　 End If
>>>　
>>>End Sub


	【77114】Re:シート1とシート2の内容で一致するも...

β - 15/5/22(金) 17:57 -


	引用なし

	パスワード

▼あやさん：

それではサンプル第２弾として。
マッチしなかったＡ列の値を配列の vntA に、B列の値を配列の vntB に格納しています。
これを参考にがんばれますか？

Sub Sample2()
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　Dim vntA As Variant
　　Dim vntB As Variant
　　
　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　
　　 With Sheets("Sheet4")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　　　If IsArray(vntA) Then
　　　　　　　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
　　　　　　　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
　　　　　　　　Else
　　　　　　　　　　ReDim vntA(1 To 1)
　　　　　　　　　　ReDim vntB(1 To 1)
　　　　　　　　End If
　　　　　　　　
　　　　　　　　vntA(UBound(vntA)) = c.Value
　　　　　　　　vntB(UBound(vntB)) = c.Offset(, 1).Value
　　　　　　　　
　　　　　　End If
　　　　Next
　　End With
　　
　　If IsArray(vntA) Then
　　　　MsgBox "A列では以下のものがマッチしません" & vbLf & Join(vntA, vbLf)
　　　　MsgBox "そのB列の値は以下です" & vbLf & Join(vntB, vbLf)
　　Else
　　　　MsgBox "すべてマッチしていますよ"
　　End If
　　
End Sub


	【77115】Re:シート1とシート2の内容で一致するも...

あや - 15/5/22(金) 19:30 -


	引用なし

	パスワード

▼β さん：
上手くいきそうです・・・！

教えていただきたいのですが、下記のコードは具体的に何をしているか教えていただけないでしょうか。

>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　If IsArray(vntA) Then
>　　　　　　　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
>　　　　　　　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
>　　　　　　　　Else
>　　　　　　　　　　ReDim vntA(1 To 1)
>　　　　　　　　　　ReDim vntB(1 To 1)
>　　　　　　　　End If

>▼あやさん：
>
>それではサンプル第２弾として。
>マッチしなかったＡ列の値を配列の vntA に、B列の値を配列の vntB に格納しています。
>これを参考にがんばれますか？
>
>Sub Sample2()
>　　Dim r As Range
>　　Dim c As Range
>　　Dim f As Range
>　　Dim vntA As Variant
>　　Dim vntB As Variant
>　　
>　　With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>　
>　　 With Sheets("Sheet4")
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　If IsArray(vntA) Then
>　　　　　　　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
>　　　　　　　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
>　　　　　　　　Else
>　　　　　　　　　　ReDim vntA(1 To 1)
>　　　　　　　　　　ReDim vntB(1 To 1)
>　　　　　　　　End If
>　　　　　　　　
>　　　　　　　　vntA(UBound(vntA)) = c.Value
>　　　　　　　　vntB(UBound(vntB)) = c.Offset(, 1).Value
>　　　　　　　　
>　　　　　　End If
>　　　　Next
>　　End With
>　　
>　　If IsArray(vntA) Then
>　　　　MsgBox "A列では以下のものがマッチしません" & vbLf & Join(vntA, vbLf)
>　　　　MsgBox "そのB列の値は以下です" & vbLf & Join(vntB, vbLf)
>　　Else
>　　　　MsgBox "すべてマッチしていますよ"
>　　End If
>　　
> End Sub


	【77116】Re:シート1とシート2の内容で一致するも...

β - 15/5/22(金) 19:47 -


	引用なし

	パスワード

▼あやさん：

多分わからないのは

If f Is Nothing Then

　　If IsArray(vntA) Then
　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
　　Else
　　　　ReDim vntA(1 To 1)
　　　　ReDim vntB(1 To 1)
　　End If

　　vntA(UBound(vntA)) = c.Value
　　vntB(UBound(vntB)) = c.Offset(, 1).Value

End If

ここですね。

配列にアンマッチのセルの情報を格納していくのですが、何個あるかわからないので
最初は Dim vntA As Variant といったように、配列ではなく、Variant型の変数として定義します。

で、データを格納する際、最初は、vntAやvntBは配列ではないので
IsArray(vntA) これは、配列なのかどうかの判定ですが、それがFalse。
なので、Else で
　　　　ReDim vntA(1 To 1)
　　　　ReDim vntB(1 To 1)
こうして、それぞれ、要素が１つだけの配列をまず生成します。
一方、２つめ以降は、IsArray(vntA) が True なので
　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)

これは　配列に今まではいっているものはそのままにして（Preserve) 配列を
指定された大きさにかえなさいというコードです。
で、UBound(vntA) は、その時点での要素数です。それに 1　を加えた数、つまり
今から格納しようとする値がはいる要素を１つ追加します。

で、

　　vntA(UBound(vntA)) = c.Value
　　vntB(UBound(vntB)) = c.Offset(, 1).Value

この時点では UBound は追加分が加えられた最終要素番号になっていますので
そこに、c.Value(A列の値）や c.Offset(,1).Value(B列の値）を格納します。


	【77144】Re:シート1とシート2の内容で一致するも...

あや - 15/5/26(火) 10:11 -


	引用なし

	パスワード

▼β さん：
なんとなーくはわかるのですが・・・
勉強不足で申し訳ありません・・・
もう少し噛み砕いていただけるとありがたいです・・・

>▼あやさん：
>
>多分わからないのは
>
>If f Is Nothing Then
>
>　　If IsArray(vntA) Then
>　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
>　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
>　　Else
>　　　　ReDim vntA(1 To 1)
>　　　　ReDim vntB(1 To 1)
>　　End If
>
>　　vntA(UBound(vntA)) = c.Value
>　　vntB(UBound(vntB)) = c.Offset(, 1).Value
>
>End If
>
>ここですね。
>
>配列にアンマッチのセルの情報を格納していくのですが、何個あるかわからないので
>最初は Dim vntA As Variant といったように、配列ではなく、Variant型の変数として定義します。
>
>で、データを格納する際、最初は、vntAやvntBは配列ではないので
>IsArray(vntA) これは、配列なのかどうかの判定ですが、それがFalse。
>なので、Else で
>　　　　ReDim vntA(1 To 1)
>　　　　ReDim vntB(1 To 1)
>こうして、それぞれ、要素が１つだけの配列をまず生成します。
>一方、２つめ以降は、IsArray(vntA) が True なので
>　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
>　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
>
>これは　配列に今まではいっているものはそのままにして（Preserve) 配列を
>指定された大きさにかえなさいというコードです。
>で、UBound(vntA) は、その時点での要素数です。それに 1　を加えた数、つまり
>今から格納しようとする値がはいる要素を１つ追加します。
>
>で、
>
>　　vntA(UBound(vntA)) = c.Value
>　　vntB(UBound(vntB)) = c.Offset(, 1).Value
>
>この時点では UBound は追加分が加えられた最終要素番号になっていますので
>そこに、c.Value(A列の値）や c.Offset(,1).Value(B列の値）を格納します。


	【77145】Re:シート1とシート2の内容で一致するも...

β - 15/5/26(火) 12:04 -


	引用なし

	パスワード

▼あやさん：
>▼β さん：
>なんとなーくはわかるのですが・・・
>勉強不足で申し訳ありません・・・
>もう少し噛み砕いていただけるとありがたいです・・・

今から２日間ほど、外出しますので、次のレスは、しばらくできません。
説明は難しいですね。
以下にサンプルコードをアップします。
実行してみて、そのあと、コード内のコメントを読んでみてください。

Sub Sample()
　　Dim v As Variant　　'格納する要素数が不定なので、とりあえずVariant型で。
　　Dim i As Long
　　
　　'今から３つの要素を配列にいれます。
　　
　　For i = 1 To 3
　　　　If IsArray(v) Then　　　'２回目以降は配列になっています
　　　　　　ReDim Preserve v(1 To UBound(v) + 1)
　　　　　　　　'2回目なら、配列の要素数は 1。そこに最初の値が格納済み。
　　　　　　　　'UBoundが1ですね。ここに2つめの要素を格納したいので
　　　　　　　　'もう１つ、要素が入る箱を準備します。
　　　　　　　　'Ubound(v) つまり 1 に 1 を足した 2番目の箱を追加しています。
　　　　　　　　'3回目なら、配列の要素数は 2。そこに、最初と2番目の要素が格納済み。
　　　　　　　　'なので、要素番号 3 の箱を準備します。
　　　　　　　　'UBound(v) つまり 2 に 1 を足した　3番目の箱が準備されます。
　　　　　　
　　　　Else　　　　　　　　　　'最初は配列ではありませんね。
　　　　　　ReDim v(1 To 1)　　 'なので、要素数が１つだけの配列に初期化します。
　　　　　　　　　　　　　　　　'LBound(配列)は配列内の最初の要素番号
　　　　　　　　　　　　　　　　'UBound(配列)は配列内の最後の要素番号
　　　　　　　　　　　　　　　　'ここでの初期化された配列の最後の要素番号は 1 です。
　　　　End If
　　　　
　　　　'ここでは、すでに、新しい要素が入るための箱が追加されています。
　　　　'その要素番号が、この配列の最後の箱の番号。つまり、現時点の UB0ound(v) です。
　　　　
　　　　v(UBound(v)) = "ABC" & i　　'その最後の箱に要素を格納します。
　　Next
　　
　　'最初は配列ではなくVariant型の変数でしたが、ここでは要素数が3つあり、そこに
　　'値が入った配列になっています。
　　
　　MsgBox UBound(v)
　　MsgBox v(1) & vbLf & v(2) & vbLf & v(3)
　　　　
End Sub


	【77153】Re:シート1とシート2の内容で一致するも...

β - 15/5/27(水) 22:49 -


	引用なし

	パスワード

▼あやさん：

追加でもう一つ確認材料の補足を。

アップしたサンプルコードをステップ実行してみてください。
その流れの中で変数 v は以下のように変化していきます。
□は配列の要素、中身はからっぽ。■は、配列の要素、中身に値が格納済み。

最初　ただのVariant型変数（配列ではない）

Redim v(1 to 1)　　　　　　　　　　　□　　　要素が１つだけ。
v(Ubound(v)) = "ABC" & i　　　　　　■　　　値として ABC1 が格納される。
Redim Preserve v(1 to UBound(v)+1)　 ■□　　空っぽの要素が１つ追加され要素数としては 2　になる。
v(Ubound(v)) = "ABC" & i　　　　　　■■　　最大要素（2番目)の値として ABC2 が格納される。
Redim Preserve v(1 to UBound(v)+1)　 ■■□　空っぽの要素が１つ追加され要素数としては 3　になる。
v(Ubound(v)) = "ABC" & i　　　　　　■■■　最大要素（3番目)の値として ABC3 が格納される。　


	【77157】Re:シート1とシート2の内容で一致するも...

あや - 15/5/28(木) 14:05 -


	引用なし

	パスワード

▼β さん：
サンプルコード有難うございます。
仕組みが分かりました。

ごめんなさい、追加で質問なのですが、
一番初めに引っかかったところだけエラーを出すようにしたいのですが・・・

例１）
Sheet1
A列
もも
りんご
いちご
ぶどう
みかん

Sheet2
A列　　B列
ぶどう　紫
めろん　緑
かき　オレンジ

結果：緑

例２）
Sheet1
もも
りんご
いちご
ぶどう
みかん

Sheet2
いちご　赤
ぶどう　紫
かき　オレンジ
れもん　黄色

結果：オレンジ

という風な感じなのですが・・・
調べるところで繰り返し処理にしなければ上手くいくのかな、と最初思ったのですが・・・
上手くコードがつながっていないようでダメでした。

>▼あやさん：
>
>追加でもう一つ確認材料の補足を。
>
>アップしたサンプルコードをステップ実行してみてください。
>その流れの中で変数 v は以下のように変化していきます。
>□は配列の要素、中身はからっぽ。■は、配列の要素、中身に値が格納済み。
>
>最初　ただのVariant型変数（配列ではない）
>
>Redim v(1 to 1)　　　　　　　　　　　□　　　要素が１つだけ。
>v(Ubound(v)) = "ABC" & i　　　　　　■　　　値として ABC1 が格納される。
>Redim Preserve v(1 to UBound(v)+1)　 ■□　　空っぽの要素が１つ追加され要素数としては 2　になる。
>v(Ubound(v)) = "ABC" & i　　　　　　■■　　最大要素（2番目)の値として ABC2 が格納される。
>Redim Preserve v(1 to UBound(v)+1)　 ■■□　空っぽの要素が１つ追加され要素数としては 3　になる。
>v(Ubound(v)) = "ABC" & i　　　　　　■■■　最大要素（3番目)の値として ABC3 が格納される。


	【77158】Re:シート1とシート2の内容で一致するも...

β - 15/5/28(木) 16:48 -


	引用なし

	パスワード

▼あやさん：

アップした Sample2 では、アンマッチのものすべてを配列に格納し、
それらすべてを表示しています。コードでは表示していませんが、
アンマッチ件数も、配列の要素の数で求めることができます。

Sample2 では Sheet4 を相手にしていましたので、それを Sheet2 にかえ
最後のメッセージのみを、配列の最初の要素（つまり最初に引っかかったもの）から
表示したものが以下の Sample3 です。

で、本格的に（？）１つひっかかったら、それでおしまいにしたコードが
Sample4 です。

Sub Sample3()
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　Dim vntA As Variant
　　Dim vntB As Variant
　
　　 With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With

　　　With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　　　If IsArray(vntA) Then
　　　　　　　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
　　　　　　　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
　　　　　　　　Else
　　　　　　　　　　ReDim vntA(1 To 1)
　　　　　　　　　　ReDim vntB(1 To 1)
　　　　　　　　End If
　　　　
　　　　　　　　vntA(UBound(vntA)) = c.Value
　　　　　　　　vntB(UBound(vntB)) = c.Offset(, 1).Value
　　　　
　　　　　　 End If
　　　　Next
　　End With
　
　　If IsArray(vntA) Then
　　　　MsgBox "最初のアンマッチは " & vntA(1) & " の " & vntB(1) & " でした"
　　Else
　　　　MsgBox "すべてマッチしていますよ"
　　End If
　
End Sub

Sub Sample4()
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　Dim vntA As Variant
　　Dim vntB As Variant
　
　　 With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With

　　　With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　　　MsgBox "最初のアンマッチは " & c.Value & " の " & c.Offset(, 1).Value & " でした"
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End With
　
End Sub


	【77159】Re:シート1とシート2の内容で一致するも...

あや - 15/5/28(木) 19:57 -


	引用なし

	パスワード

▼β さん：
サンプル4の方ですっきりしました！
確かにその書き方をすれば一致しないものがあった時点でメッセージを出してくれますね！

さらにご相談で申し訳ありません。
一致しないものを探すときに、”or”を使うものが出てきてしまいそうです。

例）
Sheet1
もも
れもん
りんご
みかん
かき
すいか

一致してるか探す対象
れもん　黄色
いちご　赤
りんご　赤
ぶどう　紫

このとき、”いちご”か”りんご”はどちらかがあれば一致しているとカウントする、という風にしたいです。どちらかあり、且つ、一致しているか探す対象のその他の”れもん”と”ぶどう”もあれば、今度は以前教えていただいた、Sheet2で一致条件探す処理をする。どちらも無ければその時点で、結果表示で”赤”と表示させたいです

で、今まで頂いたサンプル1~4を利用しようとするとなかなか難しそうで・・・
そこで、ないものを探す対象は多くないので、全てコードに書いた方が簡単なのかな、と・・・・

例）
コード　”れもん”があるか　なければ”黄色”と表示　あれば次を検索
コード　”いちご”か”りんご”があるか　なければ”赤”と表示　あれば次を検索
コード　”ぶどう”があるか　なければ”紫”と表示　あれば一致検索をするコード

のような感じで・・・ごめんなさいわかりづらくて

>▼あやさん：
>
>アップした Sample2 では、アンマッチのものすべてを配列に格納し、
>それらすべてを表示しています。コードでは表示していませんが、
>アンマッチ件数も、配列の要素の数で求めることができます。
>
>Sample2 では Sheet4 を相手にしていましたので、それを Sheet2 にかえ
>最後のメッセージのみを、配列の最初の要素（つまり最初に引っかかったもの）から
>表示したものが以下の Sample3 です。
>
>で、本格的に（？）１つひっかかったら、それでおしまいにしたコードが
>Sample4 です。
>
>Sub Sample3()
>　　Dim r As Range
>　　Dim c As Range
>　　Dim f As Range
>　　Dim vntA As Variant
>　　Dim vntB As Variant
>　
>　　 With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>
>　　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　If IsArray(vntA) Then
>　　　　　　　　　　ReDim Preserve vntA(1 To UBound(vntA) + 1)
>　　　　　　　　　　ReDim Preserve vntB(1 To UBound(vntB) + 1)
>　　　　　　　　Else
>　　　　　　　　　　ReDim vntA(1 To 1)
>　　　　　　　　　　ReDim vntB(1 To 1)
>　　　　　　　　End If
>　　　　
>　　　　　　　　vntA(UBound(vntA)) = c.Value
>　　　　　　　　vntB(UBound(vntB)) = c.Offset(, 1).Value
>　　　　
>　　　　　　 End If
>　　　　Next
>　　End With
>　
>　　If IsArray(vntA) Then
>　　　　MsgBox "最初のアンマッチは " & vntA(1) & " の " & vntB(1) & " でした"
>　　Else
>　　　　MsgBox "すべてマッチしていますよ"
>　　End If
>　
>End Sub
>
>Sub Sample4()
>　　Dim r As Range
>　　Dim c As Range
>　　Dim f As Range
>　　Dim vntA As Variant
>　　Dim vntB As Variant
>　
>　　 With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>
>　　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　Set f = r.Find(What:=c.Value, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　MsgBox "最初のアンマッチは " & c.Value & " の " & c.Offset(, 1).Value & " でした"
>　　　　　　　　Exit For
>　　　　　　End If
>　　　　Next
>　　End With
>　
>End Sub


	【77160】Re:シート1とシート2の内容で一致するも...

β - 15/5/28(木) 20:31 -


	引用なし

	パスワード

▼あやさん：

だんだん込み入ってきましたね。
要件誤解あれば指摘願います。

Sub Sample5()
　　Dim dic As Object
　　Dim r As Range
　　Dim c As Range
　　Dim f As Range
　　Dim k As Variant
　　Dim fVnt(1 To 1) As String
　　Dim w As Variant
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　　
　　With Sheets("Sheet2")
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　k = c.Offset(, 1).Value　　　　 'B列の値赤とか緑とか
　　　　　　If Not dic.exists(k) Then　　　 'はじめてあらわれた色か？
　　　　　　　　fVnt(1) = c.Value　　　　　 '要素１つだけの配列にみかん等を格納し
　　　　　　　　dic(k) = fVnt　　　　　　　 'それを辞書に登録(見出しは色）
　　　　　　Else
　　　　　　　　w = dic(k)　　　　　　　　　'辞書に登録されている配列を取り出し
　　　　　　　　ReDim Preserve w(1 To UBound(w) + 1)　　'要素数を１つ増やし
　　　　　　　　w(UBound(w)) = c.Value　　　'追加された最終要素にみかん等を格納し
　　　　　　　　dic(k) = w　　　　　　　　　'それを辞書に再登録（置換　見出しは色）
　　　　　　End If
　　　　Next
　　End With
　　
　　For Each k In dic　 '辞書から色を取り出す
　　　　For Each w In dic(k)　　'そのいろに紐付くみかん等を取り出す
　　　　　　Set f = r.Find(What:=w, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　　　MsgBox "アンマッチは " & k & "(" & w & ")"
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　Next
　　　　
End Sub


	【77165】Re:シート1とシート2の内容で一致するも...

あや - 15/5/29(金) 19:16 -


	引用なし

	パスワード

▼β さん：
説明が悪くてごめんなさい！！
以下のような感じです。

＝＝＝＝＝＝＝＝＝
Sub Sumple6
Dim　＊＊＊(変数宣言)
・
・
・

If　”レモン”がない
MsgBox　”黄色です”

ElseIf　”いちご”or”りんご”がない
MsgBox　”赤です”

ElseIf　”ぶどう”がない
MsgBox　”紫です”

Else
以前教えていただいた一致条件のコード

EndIf
・
・
・
End Sub
＝＝＝＝＝＝＝
　
というような感じで、Sheet2のA列のものと一致するか、とかではなく、コードに探す対象も書いてしまったほうが私にとって理解しやすいのかなと・・・
ごめんなさい、宜しくお願いします。

>▼あやさん：
>
>だんだん込み入ってきましたね。
>要件誤解あれば指摘願います。
>
>Sub Sample5()
>　　Dim dic As Object
>　　Dim r As Range
>　　Dim c As Range
>　　Dim f As Range
>　　Dim k As Variant
>　　Dim fVnt(1 To 1) As String
>　　Dim w As Variant
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　
>　　With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>　　
>　　With Sheets("Sheet2")
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　k = c.Offset(, 1).Value　　　　 'B列の値赤とか緑とか
>　　　　　　If Not dic.exists(k) Then　　　 'はじめてあらわれた色か？
>　　　　　　　　fVnt(1) = c.Value　　　　　 '要素１つだけの配列にみかん等を格納し
>　　　　　　　　dic(k) = fVnt　　　　　　　 'それを辞書に登録(見出しは色）
>　　　　　　Else
>　　　　　　　　w = dic(k)　　　　　　　　　'辞書に登録されている配列を取り出し
>　　　　　　　　ReDim Preserve w(1 To UBound(w) + 1)　　'要素数を１つ増やし
>　　　　　　　　w(UBound(w)) = c.Value　　　'追加された最終要素にみかん等を格納し
>　　　　　　　　dic(k) = w　　　　　　　　　'それを辞書に再登録（置換　見出しは色）
>　　　　　　End If
>　　　　Next
>　　End With
>　　
>　　For Each k In dic　 '辞書から色を取り出す
>　　　　For Each w In dic(k)　　'そのいろに紐付くみかん等を取り出す
>　　　　　　Set f = r.Find(What:=w, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　　　MsgBox "アンマッチは " & k & "(" & w & ")"
>　　　　　　　　Exit For
>　　　　　　End If
>　　　　Next
>　　Next
>　　　　
>End Sub


	【77166】Re:シート1とシート2の内容で一致するも...

β - 15/5/29(金) 21:40 -


	引用なし

	パスワード

▼あやさん：

「以下のような感じ」をそのままコードにしました。

Sub Sample7()
　　Dim f As Range
　　Dim f2 As Range
　　Dim r As Range
　　
　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　　
　　Set f = r.Find(What:="れもん", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "黄色がない"
　　End If
　　
　　Set f = r.Find(What:="いちご", LookAt:=xlWhole)
　　Set f2 = r.Find(What:="りんご", LookAt:=xlWhole)
　　If f Is Nothing And f2 Is Nothing Then
　　　　MsgBox "赤色がない"
　　End If
　　
　　Set f = r.Find(What:="ぶどう", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "紫色がない"
　　End If
　　
End Sub


	【77167】Re:シート1とシート2の内容で一致するも...

β - 15/5/29(金) 21:43 -


	引用なし

	パスワード

▼あやさん：

↑　ＯＲ　だったですかね？

そうであれば

　　If f Is Nothing And f2 Is Nothing Then

これを

　　If f Is Nothing Or f2 Is Nothing Then


	【77168】Re:シート1とシート2の内容で一致するも...

β - 15/5/30(土) 6:17 -


	引用なし

	パスワード

▼あやさん：

ほんとに　↑　のようなコードでいいのかなぁ・・・？
せめて

Sub Sample8()
　　Dim f As Range
　　Dim r As Range
　　Dim w As Variant
　　Dim v As Variant
　　Dim ans As String
　　
　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　
　　For Each w In Array(Array("れもん"), Array("いちご", "りんご"), Array("ぶどう"))
　　　　For Each v In w
　　　　　　Set f = r.Find(What:=v, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　　　　
　　　　　　　　ans = ""
　　　　　　　　
　　　　　　　　Select Case v
　　　　　　　　　　Case "れもん"
　　　　　　　　　　　　ans = "黄色"
　　　　　　　　　　Case "いちご", "りんご"
　　　　　　　　　　　　ans = "赤色"
　　　　　　　　　　Case "ぶどう"
　　　　　　　　　　　　ans = "紫色"
　　　　　　　　End Select
　　　　　　　　
　　　　　　　　If ans <> "" Then
　　　　　　　　　　MsgBox ans & " がない"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　Next
　　
End Sub


	【77170】Re:シート1とシート2の内容で一致するも...

あや - 15/6/1(月) 14:17 -


	引用なし

	パスワード

▼β さん：
どちらもわかりやすく、助かりました
できれば最初に引っかかったものだけメッセージとして出したいのですが・・・

れもんが無ければその続きのいちご、りんご、ぶどうはないので・・・
また、れもんはあり、次のいちごかりんご、どちらも無ければぶどうはないので・・・

>▼あやさん：
>
>ほんとに　↑　のようなコードでいいのかなぁ・・・？
>せめて
>
>Sub Sample8()
>　　Dim f As Range
>　　Dim r As Range
>　　Dim w As Variant
>　　Dim v As Variant
>　　Dim ans As String
>　　
>　　With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>　
>　　For Each w In Array(Array("れもん"), Array("いちご", "りんご"), Array("ぶどう"))
>　　　　For Each v In w
>　　　　　　Set f = r.Find(What:=v, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　　　　
>　　　　　　　　ans = ""
>　　　　　　　　
>　　　　　　　　Select Case v
>　　　　　　　　　　Case "れもん"
>　　　　　　　　　　　　ans = "黄色"
>　　　　　　　　　　Case "いちご", "りんご"
>　　　　　　　　　　　　ans = "赤色"
>　　　　　　　　　　Case "ぶどう"
>　　　　　　　　　　　　ans = "紫色"
>　　　　　　　　End Select
>　　　　　　　　
>　　　　　　　　If ans <> "" Then
>　　　　　　　　　　MsgBox ans & " がない"
>　　　　　　　　　　Exit For
>　　　　　　　　End If
>　　　　　　End If
>　　　　Next
>　　Next
>　　
>End Sub


	【77171】Re:シート1とシート2の内容で一致するも...

β - 15/6/1(月) 15:44 -


	引用なし

	パスワード

▼あやさん：
>できれば最初に引っかかったものだけメッセージとして出したいのですが・・・

基本的に、何かを行った後処理を終了させるには Exit Sub を使えばよろしいかと。
Exit Sub は、プロシジャ実行を終了させます。もし、この処理の後、この処理とは別の処理をするなら
プロシジャを終了さセルに尾はまずいのですが、今回は、別の処理がないので。

Sub Sample7_2()
　　Dim f As Range
　　Dim f2 As Range
　　Dim r As Range
　
　　 With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With
　
　　 Set f = r.Find(What:="れもん", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "黄色がない"
　　　　Exit Sub
　　End If
　
　　Set f = r.Find(What:="いちご", LookAt:=xlWhole)
　　Set f2 = r.Find(What:="りんご", LookAt:=xlWhole)
　　If f Is Nothing Or f2 Is Nothing Then
　　　　MsgBox "赤色がない"
　　　　Exit Sub
　　End If
　
　　 Set f = r.Find(What:="ぶどう", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "紫色がない"
　　　　Exit Sub
　　End If
　
End Sub

Sub Sample8_2()
　　Dim f As Range
　　Dim r As Range
　　Dim w As Variant
　　Dim v As Variant
　　Dim ans As String
　
　　 With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With

　　 For Each w In Array(Array("れもん"), Array("いちご", "りんご"), Array("ぶどう"))
　　　　For Each v In w
　　　　　　Set f = r.Find(What:=v, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　　　
　　　　　　　　 ans = ""
　　　　
　　　　　　　　 Select Case v
　　　　　　　　　　Case "れもん"
　　　　　　　　　　　　ans = "黄色"
　　　　　　　　　　Case "いちご", "りんご"
　　　　　　　　　　　　ans = "赤色"
　　　　　　　　　　Case "ぶどう"
　　　　　　　　　　　　ans = "紫色"
　　　　　　　　End Select
　　　　
　　　　　　　　 If ans <> "" Then
　　　　　　　　　　MsgBox ans & " がない"
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　Next
　
End Sub


	【77172】Re:シート1とシート2の内容で一致するも...

あや - 15/6/1(月) 16:37 -


	引用なし

	パスワード

▼β さん：
いただいたどちらのコードもいちごまたはりんご、片方だけある場合に”赤色がない”とでてきてしまいます・・・
両方ともあれば出ませんでした・・・
ごめんなさい、教えていただけないでしょうか

>▼あやさん：
>>できれば最初に引っかかったものだけメッセージとして出したいのですが・・・
>
>基本的に、何かを行った後処理を終了させるには Exit Sub を使えばよろしいかと。
>Exit Sub は、プロシジャ実行を終了させます。もし、この処理の後、この処理とは別の処理をするなら
>プロシジャを終了さセルに尾はまずいのですが、今回は、別の処理がないので。
>
>Sub Sample7_2()
>　　Dim f As Range
>　　Dim f2 As Range
>　　Dim r As Range
>　
>　　 With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>　
>　　 Set f = r.Find(What:="れもん", LookAt:=xlWhole)
>　　If f Is Nothing Then
>　　　　MsgBox "黄色がない"
>　　　　Exit Sub
>　　End If
>　
>　　Set f = r.Find(What:="いちご", LookAt:=xlWhole)
>　　Set f2 = r.Find(What:="りんご", LookAt:=xlWhole)
>　　If f Is Nothing Or f2 Is Nothing Then
>　　　　MsgBox "赤色がない"
>　　　　Exit Sub
>　　End If
>　
>　　 Set f = r.Find(What:="ぶどう", LookAt:=xlWhole)
>　　If f Is Nothing Then
>　　　　MsgBox "紫色がない"
>　　　　Exit Sub
>　　End If
>　
>End Sub
>
>Sub Sample8_2()
>　　Dim f As Range
>　　Dim r As Range
>　　Dim w As Variant
>　　Dim v As Variant
>　　Dim ans As String
>　
>　　 With Sheets("Sheet1")
>　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　End With
>
>　　 For Each w In Array(Array("れもん"), Array("いちご", "りんご"), Array("ぶどう"))
>　　　　For Each v In w
>　　　　　　Set f = r.Find(What:=v, LookAt:=xlWhole)
>　　　　　　If f Is Nothing Then
>　　　
>　　　　　　　　 ans = ""
>　　　　
>　　　　　　　　 Select Case v
>　　　　　　　　　　Case "れもん"
>　　　　　　　　　　　　ans = "黄色"
>　　　　　　　　　　Case "いちご", "りんご"
>　　　　　　　　　　　　ans = "赤色"
>　　　　　　　　　　Case "ぶどう"
>　　　　　　　　　　　　ans = "紫色"
>　　　　　　　　End Select
>　　　　
>　　　　　　　　 If ans <> "" Then
>　　　　　　　　　　MsgBox ans & " がない"
>　　　　　　　　　　Exit Sub
>　　　　　　　　End If
>　　　　　　End If
>　　　　Next
>　　Next
>　
>End Sub


	【77174】Re:シート1とシート2の内容で一致するも...

β - 15/6/1(月) 17:11 -


	引用なし

	パスワード

▼あやさん：
>▼β さん：
>いただいたどちらのコードもいちごまたはりんご、片方だけある場合に”赤色がない”とでてきてしまいます・・・
>両方ともあれば出ませんでした・・・
>ごめんなさい、教えていただけないでしょうか

はい。そうしています。
つまり、　いちご　と　りんご　をグループとして、そのどれかがない場合は
それがないとみなしてメッセージだして終了。

いわゆる　ＯＲ　で判定。

そうではなく、いちご、りんごがグループの場合は、そのグループ内のすべてがない場合に
メッセージで終了というのが要件でしたか？

それなら、そういうように対応しますが？


	【77175】Re:シート1とシート2の内容で一致するも...

β - 15/6/1(月) 20:28 -


	引用なし

	パスワード

▼あやさん：

とりあえず（？）グループすべてがない場合にメッセージをだして終わるパターンです。

Sub Sample7_3()
　　Dim f As Range
　　Dim f2 As Range
　　Dim r As Range

　　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With

　　　Set f = r.Find(What:="れもん", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "黄色がない"
　　　　Exit Sub
　　End If

　　 Set f = r.Find(What:="いちご", LookAt:=xlWhole)
　　Set f2 = r.Find(What:="りんご", LookAt:=xlWhole)
　　If f Is Nothing And f2 Is Nothing Then
　　　　MsgBox "赤色がない"
　　　　Exit Sub
　　End If

　　　Set f = r.Find(What:="ぶどう", LookAt:=xlWhole)
　　If f Is Nothing Then
　　　　MsgBox "紫色がない"
　　　　Exit Sub
　　End If

End Sub

Sub Sample8_3()
　　Dim f As Range
　　Dim r As Range
　　Dim w As Variant
　　Dim v As Variant
　　Dim ans As String
　　Dim cnt As Long
　　
　　　With Sheets("Sheet1")
　　　　Set r = .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　End With

　　 For Each w In Array(Array("れもん"), Array("いちご", "りんご"), Array("ぶどう"))
　　　　cnt = 0
　　　　For Each v In w
　　　　　　Set f = r.Find(What:=v, LookAt:=xlWhole)
　　　　　　If f Is Nothing Then
　
　　　　　　　　　ans = ""
　　
　　　　　　　　　Select Case v
　　　　　　　　　　Case "れもん"
　　　　　　　　　　　　ans = "黄色"
　　　　　　　　　　Case "いちご", "りんご"
　　　　　　　　　　　　ans = "赤色"
　　　　　　　　　　Case "ぶどう"
　　　　　　　　　　　　ans = "紫色"
　　　　　　　　End Select
　　　　　　　　cnt = cnt + 1
　　　　　　　　
　　　　　　End If
　　　　Next
　　　　
　　　　If cnt = UBound(w) + 1 Then
　　　　　　MsgBox ans & " がない"
　　　　　　Exit Sub
　　　　End If
　　　　
　　Next

End Sub


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

976 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free