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 -

引用なし
パスワード
   ▼あや さん:

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

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

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

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

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

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

1.Sheet3のA1に行挿入
2.Sheet3のA1に「大阪」と入力
3.Sheet3のB2に式入力 =COUNTIF(Sheet2!A:A,A2)
4.Sheet3のB列を下方向にフィルコピー
5.Sheet3でオートフィルター
6.Sheet3のB列で数値フィルター 0と等しくない
7.Sheet3のA列抽出行をSheet1のA列にコピペ
8.Sheet3のオートフィルター解除
9.Sheet3のB列削除
10.Sheet3の1行目を選択し行削除

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

引用なし
パスワード
   ▼マナ さん:
回答ありがとうございます。
マクロを使う方法なのですね。
試してみます。


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

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

引用なし
パスワード
   ▼あや さん:

まず、このコードは2つの入れ物を使っています。
1つが Dictionary と呼ばれるもの。もう1つがArrayListと呼ばれるものです。
いずれもVBAの持ち物ではなく 外部(.Net等)の機能なので、CreateObject で呼び出して使用。

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

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

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

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

さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
集約して1件にして表示するなら、重複情報も 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)を使うとうまくいかなかったもので・・・)

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

>▼あや さん:
>
>まず、このコードは2つの入れ物を使っています。
> 1つが Dictionary と呼ばれるもの。もう1つがArrayListと呼ばれるものです。
>いずれもVBAの持ち物ではなく 外部(.Net等)の機能なので、CreateObject で呼び出して使用。
>
>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>Sheet2の名前を格納するのに使っています。山田が何件あろうと1件の山田になります。
>
>ArrayListは、キー/データという概念はないのですが同じ値を別のものとして格納可能です。
>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が3件あれば3件格納されます。
>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>エラーメッセージで
>山田
> 佐藤
> 山田
> 佐藤
>とだすより
>山田
> 山田
> 佐藤
> 佐藤
>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。(これが dl.Sort です)
>
>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>判定ができます。それが dic.exists(c.Value) で、このメソッドが返す結果が True なら 
> 重複しているということになりますので、それを dl.Add c.Value でArrayList に登録しています。
>
>ArrayListに格納した内容は、VBAからは一挙に取り出せないので、ArrayListと同じ大きさの
>ReDim v(0 To dl.Count - 1) で1次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>v(i) = dl(i) で、データを取り出しておさめています。
> (ArrayListのインデックスは 0 から始まっています)
>
>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>集約して1件にして表示するなら、重複情報も 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)を使うとうまくいかなかったもので・・・)
>
>何度も申し訳ありません。
>
>>▼あや さん:
>>
>>まず、このコードは2つの入れ物を使っています。
>> 1つが Dictionary と呼ばれるもの。もう1つがArrayListと呼ばれるものです。
>>いずれもVBAの持ち物ではなく 外部(.Net等)の機能なので、CreateObject で呼び出して使用。
>>
>>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>>Sheet2の名前を格納するのに使っています。山田が何件あろうと1件の山田になります。
>>
>>ArrayListは、キー/データという概念はないのですが同じ値を別のものとして格納可能です。
>>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が3件あれば3件格納されます。
>>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>>エラーメッセージで
>>山田
>> 佐藤
>> 山田
>> 佐藤
>>とだすより
>>山田
>> 山田
>> 佐藤
>> 佐藤
>>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。(これが dl.Sort です)
>>
>>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>>判定ができます。それが dic.exists(c.Value) で、このメソッドが返す結果が True なら 
>> 重複しているということになりますので、それを dl.Add c.Value でArrayList に登録しています。
>>
>>ArrayListに格納した内容は、VBAからは一挙に取り出せないので、ArrayListと同じ大きさの
>>ReDim v(0 To dl.Count - 1) で1次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>>v(i) = dl(i) で、データを取り出しておさめています。
>> (ArrayListのインデックスは 0 から始まっています)
>>
>>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>>集約して1件にして表示するなら、重複情報も 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)を使うとうまくいかなかったもので・・・)
>>
>>何度も申し訳ありません。
>>
>>>▼あや さん:
>>>
>>>まず、このコードは2つの入れ物を使っています。
>>> 1つが Dictionary と呼ばれるもの。もう1つがArrayListと呼ばれるものです。
>>>いずれもVBAの持ち物ではなく 外部(.Net等)の機能なので、CreateObject で呼び出して使用。
>>>
>>>Dictionary は同じキーを格納した時に上書きされる特徴をもっていて、コードでは
>>>Sheet2の名前を格納するのに使っています。山田が何件あろうと1件の山田になります。
>>>
>>>ArrayListは、キー/データという概念はないのですが同じ値を別のものとして格納可能です。
>>>コードでは、重複のあったものを格納するのに使っています。Sheet3 に山田が3件あれば3件格納されます。
>>>また、ArrayListは格納されたものを昇順、降順に並び替える機能もあります。
>>>エラーメッセージで
>>>山田
>>> 佐藤
>>> 山田
>>> 佐藤
>>>とだすより
>>>山田
>>> 山田
>>> 佐藤
>>> 佐藤
>>>とだすほうがわかりやすいので、この昇順並び替え機能を使っています。(これが dl.Sort です)
>>>
>>>Dictionaryには、Existsメソッドがあり、ある値が、Dictionaryのキーとして格納されているかどうかの
>>>判定ができます。それが dic.exists(c.Value) で、このメソッドが返す結果が True なら 
>>> 重複しているということになりますので、それを dl.Add c.Value でArrayList に登録しています。
>>>
>>>ArrayListに格納した内容は、VBAからは一挙に取り出せないので、ArrayListと同じ大きさの
>>>ReDim v(0 To dl.Count - 1) で1次元配列をつくり、その配列に、ArrayListからインデックスを与えながら
>>>v(i) = dl(i) で、データを取り出しておさめています。
>>> (ArrayListのインデックスは 0 から始まっています)
>>>
>>>さて、重複側を、あえてその件数だけすべて表示するという要望でしたのでArrayListを使いましたが
>>>集約して1件にして表示するなら、重複情報も 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))
>
>に。

はい。これでOKです。
こちらで、この形にして、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))
>>
>>に。
>
>はい。これでOKです。
>こちらで、この形にして、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 の形で使ってもらうか 完全一致なら
現在のそちらのコードを、以下のように。(★印の2か所を変更しています)

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 の形で使ってもらうか 完全一致なら
>現在のそちらのコードを、以下のように。(★印の2か所を変更しています)
>
>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 の形で使ってもらうか 完全一致なら
>>現在のそちらのコードを、以下のように。(★印の2か所を変更しています)
>>
>>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 の形で使ってもらうか 完全一致なら
>現在のそちらのコードを、以下のように。(★印の2か所を変更しています)
>
>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))

でOKですよ。

【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))
>
>でOKですよ。

【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/● とやったほうが操作しやすいかも。

なお、ボタン(マクロ)は1つでまかないましょう。

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/● とやったほうが操作しやすいかも。
>
>なお、ボタン(マクロ)は1つでまかないましょう。
>
>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/● とやったほうが操作しやすいかも。
>>
>>なお、ボタン(マクロ)は1つでまかないましょう。
>>
>>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/● とやったほうが操作しやすいかも。
>>>
>>>なお、ボタン(マクロ)は1つでまかないましょう。
>>>
>>>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/● とやったほうが操作しやすいかも。
>>>
>>>なお、ボタン(マクロ)は1つでまかないましょう。
>>>
>>>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 に限定して
メッセージをだす、で、だす際には、その地域である いいいい や ええええ で出す。
(いいかえれえば、地域で1つしか出さないようにしています)

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

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

引用なし
パスワード
   ▼β さん:
そうです!
説明不足でした。失礼いたしました。

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

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

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

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

引用なし
パスワード
   ▼あや さん:

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

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

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

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

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

引用なし
パスワード
   ▼あや さん:

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

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 で、次の赤セルに
>とぶはずですが?
>もし、検索後、B列以外を選択してから Ctrl/j をおせば、はじめからになりますが。
ということは一致箇所があるか検索するボタンを押して、一致箇所があれば、その時点で一致箇所のセルに飛ぶということでしょうか?

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

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

>▼あや さん:
>
>1番目が最初の重複のみ表示、2番目が最後の重複のみ表示です。
>
>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 に飛ばしています。

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

今回、赤は1つしかない、とうことは次へというものがない。
ならば、このどこからという起点を記述しないという方法もあります。
つまり、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 に飛ばしています。
>
>なので、検索起点が検索領域にないよというエラーになっているものと思います。
>
>今回、赤は1つしかない、とうことは次へというものがない。
>ならば、このどこからという起点を記述しないという方法もあります。
>つまり、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 -

引用なし
パスワード
   ▼あや さん:

こんにちは

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

1.領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
  シート全体の領域になりますから、A列以外にあってもマッチします。
2.で、After は、その領域内の検索開始セルですが、領域が Cellsなら
  ActivesCell は当然シート内ですからOKですが、領域をA列にすると
  もし、A列以外が選択されている状態ならエラーになります。
  指定するならA列内のセル(A1 とか)か、あるいは指定しない(こちらを推奨)
  指定がなければ指定領域の先頭のセルから とみなしてくれますので。
3.「大文字の」という条件ですよね。
  ところが、MatchCase:=False 。これは大文字/小文字を区別しないという意味です。
  MatchCase:=True とする必要があります。
4.Findメソッドを実行すると、検索が成功(マッチ)した場合は、そのセルオブジェクトが
  返されますが、失敗(アンマッチ)した場合は「Nothing」になります。
  この「Nothing」になっているオブジェクトは、参照できません。
  参照しようとするとエラーになります。(参照できないので Select もできません)
5.そのFIndメソッドの結果を受ける変数を oRange としていますが、この oRange は
  どこでも参照していません。かわりに Set c = Selection とした結果の c を参照。
  きっと 領域.Find(条件).Select として、その Selectされたセル(Selection)を
  使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select は
  使ってはいけない構文です。(だから使っていないんですよね)
6.c という セルオブジェクトのプロパティに ColorIndex というものはありません。
  あるのは、Interior (ほかにもたくさんありますが)
  で、ColorIndex は、Interior のプロパティです。
  ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
7.さらに、その 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列に書いてあることを結果として表示する

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

>▼あや さん:
>
>こんにちは
>
>アップされたコードにはいくつか(たくさん?)問題があります。
>
>1.領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>  シート全体の領域になりますから、A列以外にあってもマッチします。
>2.で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>  ActivesCell は当然シート内ですからOKですが、領域をA列にすると
>  もし、A列以外が選択されている状態ならエラーになります。
>  指定するならA列内のセル(A1 とか)か、あるいは指定しない(こちらを推奨)
>  指定がなければ指定領域の先頭のセルから とみなしてくれますので。
>3.「大文字の」という条件ですよね。
>  ところが、MatchCase:=False 。これは大文字/小文字を区別しないという意味です。
>  MatchCase:=True とする必要があります。
>4.Findメソッドを実行すると、検索が成功(マッチ)した場合は、そのセルオブジェクトが
>  返されますが、失敗(アンマッチ)した場合は「Nothing」になります。
>  この「Nothing」になっているオブジェクトは、参照できません。
>  参照しようとするとエラーになります。(参照できないので Select もできません)
>5.そのFIndメソッドの結果を受ける変数を oRange としていますが、この oRange は
>  どこでも参照していません。かわりに Set c = Selection とした結果の c を参照。
>  きっと 領域.Find(条件).Select として、その Selectされたセル(Selection)を
>  使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select は
>  使ってはいけない構文です。(だから使っていないんですよね)
>6.c という セルオブジェクトのプロパティに ColorIndex というものはありません。
>  あるのは、Interior (ほかにもたくさんありますが)
>  で、ColorIndex は、Interior のプロパティです。
>  ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>7.さらに、その 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列に書いてあることを結果として表示する
>
>どうか教えていただけないでしょうか。
>
>>▼あや さん:
>>
>>こんにちは
>>
>>アップされたコードにはいくつか(たくさん?)問題があります。
>>
>>1.領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>>  シート全体の領域になりますから、A列以外にあってもマッチします。
>>2.で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>>  ActivesCell は当然シート内ですからOKですが、領域をA列にすると
>>  もし、A列以外が選択されている状態ならエラーになります。
>>  指定するならA列内のセル(A1 とか)か、あるいは指定しない(こちらを推奨)
>>  指定がなければ指定領域の先頭のセルから とみなしてくれますので。
>>3.「大文字の」という条件ですよね。
>>  ところが、MatchCase:=False 。これは大文字/小文字を区別しないという意味です。
>>  MatchCase:=True とする必要があります。
>>4.Findメソッドを実行すると、検索が成功(マッチ)した場合は、そのセルオブジェクトが
>>  返されますが、失敗(アンマッチ)した場合は「Nothing」になります。
>>  この「Nothing」になっているオブジェクトは、参照できません。
>>  参照しようとするとエラーになります。(参照できないので Select もできません)
>>5.そのFIndメソッドの結果を受ける変数を oRange としていますが、この oRange は
>>  どこでも参照していません。かわりに Set c = Selection とした結果の c を参照。
>>  きっと 領域.Find(条件).Select として、その Selectされたセル(Selection)を
>>  使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select は
>>  使ってはいけない構文です。(だから使っていないんですよね)
>>6.c という セルオブジェクトのプロパティに ColorIndex というものはありません。
>>  あるのは、Interior (ほかにもたくさんありますが)
>>  で、ColorIndex は、Interior のプロパティです。
>>  ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>>7.さらに、その 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列に書いてあることを結果として表示する
>>
>>どうか教えていただけないでしょうか。
>>
>>>▼あや さん:
>>>
>>>こんにちは
>>>
>>>アップされたコードにはいくつか(たくさん?)問題があります。
>>>
>>>1.領域.Find で、その領域の中を捜すわけですが、Cells と指定すると
>>>  シート全体の領域になりますから、A列以外にあってもマッチします。
>>>2.で、After は、その領域内の検索開始セルですが、領域が Cellsなら
>>>  ActivesCell は当然シート内ですからOKですが、領域をA列にすると
>>>  もし、A列以外が選択されている状態ならエラーになります。
>>>  指定するならA列内のセル(A1 とか)か、あるいは指定しない(こちらを推奨)
>>>  指定がなければ指定領域の先頭のセルから とみなしてくれますので。
>>>3.「大文字の」という条件ですよね。
>>>  ところが、MatchCase:=False 。これは大文字/小文字を区別しないという意味です。
>>>  MatchCase:=True とする必要があります。
>>>4.Findメソッドを実行すると、検索が成功(マッチ)した場合は、そのセルオブジェクトが
>>>  返されますが、失敗(アンマッチ)した場合は「Nothing」になります。
>>>  この「Nothing」になっているオブジェクトは、参照できません。
>>>  参照しようとするとエラーになります。(参照できないので Select もできません)
>>>5.そのFIndメソッドの結果を受ける変数を oRange としていますが、この oRange は
>>>  どこでも参照していません。かわりに Set c = Selection とした結果の c を参照。
>>>  きっと 領域.Find(条件).Select として、その Selectされたセル(Selection)を
>>>  使おうとしたんだと思いますが、検索失敗のことを考えると、領域.Find(条件).Select は
>>>  使ってはいけない構文です。(だから使っていないんですよね)
>>>6.c という セルオブジェクトのプロパティに ColorIndex というものはありません。
>>>  あるのは、Interior (ほかにもたくさんありますが)
>>>  で、ColorIndex は、Interior のプロパティです。
>>>  ですから、c.Interior.ColorIndex です。c.ColorIndex だと、実行時にエラーになります。
>>>7.さらに、その 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 -

引用なし
パスワード
   ▼あや さん:

それではサンプル第2弾として。
マッチしなかったA列の値を配列の 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


>▼あや さん:
>
>それではサンプル第2弾として。
>マッチしなかったA列の値を配列の 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)
こうして、それぞれ、要素が1つだけの配列をまず生成します。
一方、2つめ以降は、IsArray(vntA) が True なので
    ReDim Preserve vntA(1 To UBound(vntA) + 1)
    ReDim Preserve vntB(1 To UBound(vntB) + 1)

これは 配列に今まではいっているものはそのままにして(Preserve) 配列を
指定された大きさにかえなさいというコードです。
で、UBound(vntA) は、その時点での要素数です。それに 1 を加えた数、つまり
今から格納しようとする値がはいる要素を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)
>こうして、それぞれ、要素が1つだけの配列をまず生成します。
>一方、2つめ以降は、IsArray(vntA) が True なので
>    ReDim Preserve vntA(1 To UBound(vntA) + 1)
>    ReDim Preserve vntB(1 To UBound(vntB) + 1)
>
>これは 配列に今まではいっているものはそのままにして(Preserve) 配列を
>指定された大きさにかえなさいというコードです。
>で、UBound(vntA) は、その時点での要素数です。それに 1 を加えた数、つまり
>今から格納しようとする値がはいる要素を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 -

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

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

Sub Sample()
  Dim v As Variant  '格納する要素数が不定なので、とりあえずVariant型で。
  Dim i As Long
  
  '今から3つの要素を配列にいれます。
  
  For i = 1 To 3
    If IsArray(v) Then   '2回目以降は配列になっています
      ReDim Preserve v(1 To UBound(v) + 1)
        '2回目なら、配列の要素数は 1。そこに最初の値が格納済み。
        'UBoundが1ですね。ここに2つめの要素を格納したいので
        'もう1つ、要素が入る箱を準備します。
        'Ubound(v) つまり 1 に 1 を足した 2番目の箱を追加しています。
        '3回目なら、配列の要素数は 2。そこに、最初と2番目の要素が格納済み。
        'なので、要素番号 3 の箱を準備します。
        'UBound(v) つまり 2 に 1 を足した 3番目の箱が準備されます。
      
    Else          '最初は配列ではありませんね。
      ReDim v(1 To 1)   'なので、要素数が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)           □   要素が1つだけ。
v(Ubound(v)) = "ABC" & i       ■   値として ABC1 が格納される。
Redim Preserve v(1 to UBound(v)+1)  ■□  空っぽの要素が1つ追加され要素数としては 2 になる。
v(Ubound(v)) = "ABC" & i       ■■  最大要素(2番目)の値として ABC2 が格納される。
Redim Preserve v(1 to UBound(v)+1)  ■■□ 空っぽの要素が1つ追加され要素数としては 3 になる。
v(Ubound(v)) = "ABC" & i       ■■■ 最大要素(3番目)の値として ABC3 が格納される。 

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

引用なし
パスワード
   ▼β さん:
サンプルコード有難うございます。
仕組みが分かりました。


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

例1)
Sheet1
A列
もも
りんご
いちご
ぶどう
みかん

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

結果:緑

例2)
Sheet1
もも
りんご
いちご
ぶどう
みかん

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

結果:オレンジ

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

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

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

引用なし
パスワード
   ▼あや さん:

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

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

で、本格的に(?)1つひっかかったら、それでおしまいにしたコードが
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 です。
>
>で、本格的に(?)1つひっかかったら、それでおしまいにしたコードが
>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      '要素1つだけの配列にみかん等を格納し
        dic(k) = fVnt        'それを辞書に登録(見出しは色)
      Else
        w = dic(k)         '辞書に登録されている配列を取り出し
        ReDim Preserve w(1 To UBound(w) + 1)  '要素数を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      '要素1つだけの配列にみかん等を格納し
>        dic(k) = fVnt        'それを辞書に登録(見出しは色)
>      Else
>        w = dic(k)         '辞書に登録されている配列を取り出し
>        ReDim Preserve w(1 To UBound(w) + 1)  '要素数を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 -

引用なし
パスワード
   ▼あや さん:

↑ OR だったですかね?

そうであれば

  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 -

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

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

いわゆる OR で判定。

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

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

【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 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free