[[20111117122023]]　『データ一致するものを転記』（ぱぐ）　ページの最後に飛ぶ

『データ一致するものを転記』（ぱぐ）

 元データと2つの項目をキーにして、２つの条件に一致するものを
別ファイルへ転記したいのですが、元データはセルの結合がされています。
それぞれ結合の幅はＢ列＝Ｃ列＝Ｈ，Ｌ、Ｐ列で同じです。

 結合は（B84:B87）、（C84：C87）、（H84：H87）・・・というカンジで
3行のところもあれば、2行、結合してないところもあります。

 取引先（Ｂ列）と品番（Ｃ列）の２つをキーに、
作成ファイルの取引先かつ品番が一致するものを数量を転記していきます。

 できればＶＢＡでやりたいです。

 ＜元データ＞
・シート名は固定されていないが一番左端のワークシート
・除外したい取引先があります。（文字列）
・取引先・・・Ｂ列（セルの結合）
・品番・・・Ｃ列（セルの結合）
・数量・・・Ｈ、Ｌ、Ｐ列（セルの結合）

 ＜作成ファイルへの作業＞
Sheet1
・客先・・・Ｃ列
・品番・・・Ｄ列
・数量・・・Ｊ、Ｌ、Ｎ列へ上記ファイルより転記

 元データの取引先品番、このシートの取引品番のセットが重複するものは、
同じ行のＱ列に品番を表記させたい。

 作成ファイルにない品番は、
一番下段(一番下のデータのひとつ下から）へＣ、Ｄ、Ｊ、Ｌ、Ｎ列のデータを
転記していきたい。

 こちらのファイルはセルの結合はありません。

 どなたか教えて頂けないでしょうか。
よろしくおねがいします。（エクセル2003）

 知りたい部分がイマイチ分かりませんが、ポイントポイントで適当に……

 >結合は（B84:B87）、（C84：C87）、（H84：H87）・・・というカンジで
 >3行のところもあれば、2行、結合してないところもあります。
　
結合セルでも、例えば
    Range("B84").Value
等で値は拾えます。

 >・シート名は固定されていないが一番左端のワークシート
　
Worksheets(1) で左端のワークシートが得られます。

 >・除外したい取引先があります。（文字列）
　
方法はいくつかあるでしょうが、例えば
    Select Case 取引先のデータ
        Case "A社"
            MsgBox "A社だよ"
        Case "B社", "C社"
            MsgBox "B社かC社だよ"
        Case Else
            MsgBox 取引先のデータ & "だよ"
    End Select
みたいな分岐をする事が考えられます。

 >・数量・・・Ｈ、Ｌ、Ｐ列（セルの結合）
 >・数量・・・Ｊ、Ｌ、Ｎ列へ上記ファイルより転記
　
例えば
    Worksheets("Sheet1").Range("J1").Value = Worksheets(1).Range("H1").Value
と言った記述で、左端のシートのH1をSheet1のJ1に値を転記できます。

 >一番下段(一番下のデータのひとつ下から）へＣ、Ｄ、Ｊ、Ｌ、Ｎ列のデータを
　
最下段の次の行の取得は例えばA列が埋まってるとすれば
    With Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1)
        MsgBox .Address & "です"
    End With
のようにすると得られます。
　
とりあえずアドバイスできる範囲で書いてみました。
あとちょっと質問文の改行等を編集させてもらいました。
（ご近所PG）

ご近所PGさま

 ありがとうございます。
投稿がはじめてで、改行などみなさんのように上手にできません。
見づらく申し訳ございません。

 結合も大丈夫でよかったです。
下段のところへ新規の品番をうめていくところなどは、どうやるのでしょうか？
A列はあいています。

 作成ファイルの末データの下から、それぞれの項目に新規品番などを入れていきたいのですが。

 できればコードを書いて頂きたいのですが・・・
そこからわからないところを質問させて頂いてもいいでしょうか？
まったくの初心者でどこから初めていいのかわかりません。
お願いします。

 >できればコードを書いて頂きたいのですが・・・
　
残念ながらコードを書く気は、少なくとも私にはありません。
今はそこまでの時間も取れないので。
先だっての回答から何もコードを書けない、まったくの無からの手解きは、
ざっくばらんに言えば、イヤです。
　
それでもかまわん、時間があるから作ってやるよ、という他の方の回答を待たれるか、
あるいは有償にて、業者へプログラム制作依頼をすべきかと思います。
　
私の方からは以上です。
（ご近所PG）

 それはフィルタオプションで取り出せる内容ですか？
 フィルタオプションでは結合の関係でうまく抽出できないという事なら
 ＶＢＡでも相当苦労する事になります。

 データを抽出する目的の元データなら結合セルは使わないのがセオリーです。
 逆に言えば、結合セルさえなければフィルタオプションで簡単に取り出せるはずです。

 ＶＢＡでやりたければそれをコード化するだけです。

 ＶＢＡの知識が足りなければ、まずはセオリーどおりにデータを作る事から始めてみせんか？
 （ｍｏｍｏ）

以前は、自社のシステムに取り込むために専用の作業ファイルに
担当が入力してもらっていたのですが
やり方が変わってしまい、
この結合だらけのファイルを見ながら
専用の作業ファイルへ転記し、自社システムへ取り込まなくてはいけなくなりました。　

　その結合ファイルは海外の支店でつくられているので変更ができません。
別の支店で作られているファイルは結合されていないので、

こちらだけでも何とかしたいのですが、
上記のような作業をＶＢＡでなくてもできるのでしょうか？

 結合セルを解除するだけなら、例えば

  Sub test()
  Dim r As Range
  For Each r In ActiveSheet.UsedRange
    If r.MergeCells = True Then
      With r.MergeArea
        .UnMerge
        .Value = .Cells(1).Value
      End With
    End If
  Next r
  End Sub

 こんなコードでも出来そうですが、データベース的に扱っていくデータなら
 元データをしっかり作りこんでおいて、見た目だけのシートを別に作った方が
 後々の為にも良いと思いますよ。
 （ｍｏｍｏ）

結合部分は、何とか頼んで使用をやめてもらいます。

結合部分がない場合は、移行作業はどうすれば効率的にできますか？

 まず最初に。。。。この掲示板の書き込み方法ですが
_←この部分に　半角スペースを入れて書き始めて下さい。

 すると、コメント欄で改行した部分がそのまま反映して表示されます。
 先頭に半角スペースが無いと、空行を挟まないと（二回改行しないと）
 改行して表示されません。
 　面倒ですが、全角スペースではなく、半角スペースを入れて下さい。

 上手に書き込みが出来る方法が分かったら
 サンプルデータを載せるのとあわせて
 シートの詳細な説明をしてみて下さい。

 ＞結合は（B84:B87）、（C84：C87）、（H84：H87）・・・というカンジで
 今回に関するデータは84行目から始まっている様ですが、83行目以上のどこかに対応する見出しがあるのか？
 データが有る範囲はどの様に特定出来るのか？
 データは何行位あるのか？

 セルの結合があって、途中で数行に別れてたりするのか？
            <1>         <2>     <3>     <4>
    [1]     項目名　　　単価    数量   日付
    [2]                          10    11/9
    [3]     みかん       30      13    11/10
    [4]                           7    11/24    ・・・<1>,[2:4] と <2>,[2:4]が結合
 等によってもどの様に話を進めていくのがよさそうか　変わってくると思います。

 結合の無いと言うシート（ファイル？）に関しても同様に
 データが隙間無く入っている（一行だけを取り出して見た時に意味を成す）かどうかは
 結構重要だと思います。

 一回に一つのシートを処理出来れば良いのか？
 と言った辺りも先に展望が分かって居た方が良い様に思います。

 また、サンプルデータを作製して頂けましたら　それを元にして考えますので
 あとから「こんなパターンがあって処理できない」なんて事にならない様
 過去のものもよく確認して、より現状が表現出来て居るものを作ってもらえると良いと思います。

 元データがきちんとしている（あくまでも、エクセル好み）なら
 ＞元データの取引先品番、このシートの取引品番のセットが重複するものは、
 ＞同じ行のＱ列に品番を表記させたい。
 の部分は、SUMPRODUCT関数が使えるのではないかと思います。
 　（同じ行のＱ列の品番は同じ行のＤ列の品番と同じですよね？）

 ＞作成ファイルにない品番は、～
 に関しては、やっぱりVBA頼みが楽かなぁ。。。

 いずれにしても、元データを整える必要が有るか無いかでも
 コードは変わってきそうに思います。

 (HANA)

 配列関数で数量をいれるところまではできましたが、
列ごとに数式をいれたりしなくてはいけなくて…
ＨＡＮＡさんありがとうございます。
やはりデータファイルは両方とも結合が入っていまして、
列も少しずれていましたので整える必要があります。

■データファイル1

	B	Ｃ	Ｈ	Ｎ	Ｔ	Ｚ
7	客先	機種	数量	数量	数量	数量
8		aaaa	100	300	500	700
9	あいう					
10		bbbb	200	400	600	800
11

・列の項目がもうひとつのデータと一致していないため

	ＬＭ、ＰＱ、ＴＵ列を削除してもうひとつ（下記）データファイルにあわせる

・セルの結合がランダム

	Ｃ列とＨ～Ｚの結合幅は同じ。Ｂ列とＣ列は結合幅は一致しない。
	上記表から(B7:B11)、(C8:C9)、（Ｈ8:Ｈ9）

■データファイル2

	B	Ｃ	Ｈ	Ｌ	Ｐ	Ｔ
7	客先	機種	数量	数量	数量	数量
8	あいう	aaaa	100	200	300	400
9	かきく	cccc	100	150	400	120
10	さしす	cccc		200	500	160

・除外する客先がある（5つほど、名前は決定しています）

・数量でセルの結合を使用している。上記ファイルより(H9:H10)

・結合をすべて解除して、空白部分は空白でも同じデータが入ってもＯＫ。

（結合で機種が重複しているものは、手作業で確認するため）

・Ｂ、Ｃ列が一致する数量を規定の下記フォーマットへ転記

規定フォーム

	A	Ｃ	Ｄ	Ｊ	Ｌ	Ｎ	Ｐ
4	重複	客先	機種	数量	数量	数量	数量
5	2	あいう	aaaa	100	200	300	400
6	2	あいう	aaaa	100	200	300	400
7		かきく	bbbb	100	200	300	400
8	新規	さしす	kkkk	100	200	300	400
9	新規	たちつ	pppp	100	200	300	400
10	新規	まみむ	vvvv	100	200	300	400
11	新規	は	eeee	100	200	300	400

Ａ列は重複チェックと新規機種のためのものです。

Ｃ列はデータファイルのＢ列

Ｄ列はデータファイルのＣ列

数量はＪ列はデータファイルのＨ列・・・というカンジになります。

可能でしょうか？

よろしくおねがいいたします。

 可能か不可能かと言う事であれば、可能だと思いますが。。。

 処理のイメージがつきやすいように、もう少し関係ない部分も教えてもらえますか？
 ご説明からは、一回の処理で複数のシート（ファイル）を相手にする様に思えますが
 その印象は合っていますか？
 それとも、一回に一つのシートに関して処理が出来れば良いのでしょうか。

 ＞・結合をすべて解除して、空白部分は空白でも同じデータが入ってもＯＫ。 
 ＞（結合で機種が重複しているものは、手作業で確認するため）
 この記述は、データファイル1,データファイル2 に共通の事でしょうか？
 それとも、データファイル2に関してのみ　でしょうか？
 　その場合、データファイル1に関して結合してあるセルはどの様に取り扱えば良いでしょう？

 また、どの段階で確認をするおつもりでしょう？

 ご提示のデータファイル1,データファイル2と、既定フォームのデータは
 整合性が無い様に感じます。

 整合性の有るもの、或いは　何故その様に転記されるのかのご説明　をお願いします。

 まず、大まかな展望として　おそらく私なら
 　既定フォームの有るシートのファイルにSheet1 と　Sheet2 を用意して
 　１．Sheet1に、それぞれのデータファイルからデータを整理しながら集めて一覧表を作る。
 　２．その後、Sheet1から既定フォームのデータと項目を見比べながら Sheet2に新たな表を作成する。
 と言う流れにすると思います。

 既定フォームのご説明の無い列に何が入っているのか気になる所ですが。。。

 (HANA)

 ３つのファイルから２つの専用フォームへ、条件があったものの
 数量を当てはめていきます。

 ◆Ａデータファイル、Ｂデータファイル　⇒　ＡＢデータが合体している専用フォーム
 ◆Ｃデータファイル　⇒　Ｃ用専用フォーム

 データと専用フォームで照合できる部分は客先と機種だけとなり
 専用フォームは機種の下に品番というカテゴリーで細かく管理しているので、
 客先と品番だと専用フォームでは下記のように機種が重複します。
 せめて重複したものは、あとで確認できるよう目印をつけるようにしたいのです。
 フォームで転記してからの確認になりますでしょうか。

 （重複例）機種：フルーツ　品番：りんご
　　　　　 機種：フルーツ　品番：バナナ

 専用フォームは自社システムのマスタから出力したExcelフォームです。
 専用フォーム自体は単純で、Ｂ列にＮＯ，その他の列は単価が入っています。
 単価、数量の列が各４つあるのは、今月～2月までの4か月分です。

 結合のためにデータを整理して一覧を作った方が見やすいですよね。
 データ、専用フォームどちらでもワークシートが増えるのは問題ありません。
 重複や新規、すべての確認を一覧表でした後、専用フォームへ転記の方がいいのでしょうか。

 みづらい上、説明までもうまくお伝えできず申し分けございません。
 どうぞご教授お願いいたします。

 ＞◆Ｃデータファイル　⇒　Ｃ用専用フォーム
 の方が簡単そうなので、まずはこっちで話を進めて良いですか？

 「Ｃデータファイル」は、↑の例だと　データファイル1,データファイル2
 どちらのパターンでしょうか？

 既定フォームは A,B用とC用で　基本的に同じでしょうか？

 C用に関しても、客先と機種では重複が発生しますか？
 「後で確認」と言う事ですが、客先と機種が決まったら品番がわかる。
 と言った決まり事があるから、後で確認出来るのですか？

 専用フォームには、事前に品番が入っているのでしょうか。。。？
 「何かの為に確認するが、流し込む段階では不要」とか言う事なのでしょうか？

 状況がわかるサンプル（Ｃデータファイル）と
 整合性のとれた結果図（Ｃ用専用フォーム）を
 もう一度載せてみてもらえると良いのですが。。。

 (HANA)

遅くなり申し訳ございません

専用フォームのフォーマットは２つとも同じです。
Ｃ用の方から説明いたします。
こちらも重複が発生し、重複の確認は別資料にてこちらの手作業となります。

 ・専用フォーム										
 （Ｉ3：Ｊ3、Ｋ3：Ｌ3、Ｍ3：Ｎ3）は結合がしてあって3か月分の月が入っています										
 データファイルのＨ列の販売計画を⇒Ｊ列へ、Ｌ列をＬ列へ、Ｐ列をＮ列へ転記										
	B	C	D	E	F	G	H	I	J	K	L	M	N					
3								11月		12月		1月						
4	No.	客先	機種名	区分	品番	モデル	納入地	単価	販売台数	単価	販売台数	単価	販売台数					
5																		
6

 ・Ｃデータファイル																		
 結合部分は、客先、機種名が同じだが、生産場所が違う場合、数量が結合されている																		
 	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
6				10月	10月末	11月(11/01～11/30）					12月(12/1～12/31)				1月(1/1～1/31)  			
7	客先	機種名	生産場所	棚卸し	在庫	出荷予定数	販売計画	生産	在庫予定	在庫	販売計画	生産	在庫予定	在庫	販売計画	生産	在庫予定	在庫
8	A会社	1111	大阪				数量下段											
9	B会社     2222	宮崎				結合

 専用フォームは販売台数以外すべての情報が入っている																		
 また、説明が足りない部分がありましたらお知らせください。
 よろしくおねがいします

 どの客先＆機種名から順に並べるのか（また、どの客先は抜き出さないのか）は
 どこかに一覧があると思いますが、何処に有りますか？

 データファイルの数量が結合されている部分は、結合を解除した時
 それぞれのセルの値はどの様に成れば良いですか？

 私が想像している事は↓サンプルなので簡単な例ですが。。。
 表1	<1>	<2>	<3>	<4>	<5>	<6>		 表2	<1>	<2>	<3>
[1]	客先			作業列	客先	数量		[1]	作業列	客先	数量
[2]	い			10	あ	1		[2]	1	い	2
[3]	か			1	い	2		[3]	2	か	6
[4]	お			10	う	3		[4]	3	お	5
[5]				10	え	4		[5]	3	お	8
[6]				3	お	5		[6]	10	あ	1
[7]				2	か	6		[7]	10	う	3
[8]				10	き	7		[8]	10	え	4
[9]				3	お	8		[9]	10	き	7
[10]								[10]			
 表1の
 1列目が並べる順番を指定する部分。
 5,6列目がデータです。

 4列目は、1列目と5列目の客先を確認して
 一致するものが有る場合は、1列目の何番目に出てくるかその番号
 一致する物が無い場合は、取り敢えず「10」を入れてあります。

 1列目は　「い」「か」「お」の順番に並んでいるので
 5列目が「い」なら1　「か」なら2　「お」なら3　その他の行には10

 表2は 4:5列目を 4列目を昇順で並べ替えた結果です。
 この表の2:3列目を　専用フォームとやらの決められた位置に貼り付ければ
 ご希望の結果に成るのではないかと思っていますが　どうでしょう？

 問題が有る様なら、別の方法を考えないといけないですが。

 大いに疑問なのですが
 「データファイル」と「抜き出すべき客先＆機種名の一覧」を渡された時 　
 専用フォームにデータを埋める事が出来るのですか？

 専用フォームの5行目以降は白紙の状態なのでしょうか？
 　でしたら、データファイルからはとにかく抜き出せば良いだけなので
 　難しく考えなくても良さそうですが。。。

 (HANA)

 うまくお伝えできずにすみません。

 作業は、Ｖlookup関数でデータをぶつけるようなイメージです。

 データから専用フォームに同じ機種と客先をぶつけます。
 専用フォームは１００行ぐらいにわたって情報が入っています。
 上記表でもありますように数量以外はすべてうまっています。

 重複するものは、そのいずれかの数量が入っていればいいです。
 ただしA列にその機種名を表示（どこでもいいですが）
 専用フォームにない新規の機種名は、専用フォームの最終行に書いていきます。
 重複したデータはＡ列で絞りこみ後で確認していきます。

 客先と機種が合っていたら、他のデータの状況に関係なく参照すれば良いのですか？

 例えば、専用フォームに　客先「AAA」機種「K-111」品番「H-+++」と成っている行が有ったとする。
 データの方は、客先「AAA」機種「K-111」と成っている行が3行有ったとする。

 ＞重複するものは、そのいずれかの数量が入っていればいいです。
 と言う事は、「無条件で一番下のデータの数量」が入っても良いと言う事ですよね？
 詳細に調べたとき、一番下のデータは品番が「H-+++」で無い可能性があっても。

 ＞ただしA列にその機種名を表示
 A列に「K-111」と表示すると言う事ですが、その後

 ＞重複したデータはＡ列で絞りこみ後で確認していきます。
 への流が良く解らないです。

 専用フォームの方は　客先「AAA」機種「K-111」と言う項目は事前に一つしか登録されていないのですよね？
 　　でないと、複数有った場合「いずれかの数量が入っていればいい」と言う表現は適さない様に思えますので。

 専用フォームに　客先「AAA」機種「K-111」と、最初から書かれている物は必ず重複が無く
 重複が有るものは、新規の機種名のみ　なのでしょうか？

 それにしては、上で載せて下さったサンプルデータは
 専用フォーム							
 処理前1							
	A	Ｃ	Ｄ	Ｊ	Ｌ	Ｎ	Ｐ
4	重複	客先	機種	数量	数量	数量	数量
5		あいう	aaaa				
6		かきく	bbbb				
7

 処理後1							
	A	Ｃ	Ｄ	Ｊ	Ｌ	Ｎ	Ｐ
4	重複	客先	機種	数量	数量	数量	数量
5	2	あいう	aaaa	100	200	300	400
6	2	あいう	aaaa	100	200	300	400
7		かきく	bbbb	100	200	300	400
8	新規	さしす	kkkk	100	200	300	400
9	新規	たちつ	pppp	100	200	300	400
10	新規	まみむ	vvvv	100	200	300	400
11	新規	は	eeee	100	200	300	400
 の様に変化している感じが有りますが。。。

 データが一致するものを転記＆抜けている物を追加
 となると（元データがどの様な物かわからないですが）

 処理後2							
	A	Ｃ	Ｄ	Ｊ	Ｌ	Ｎ	Ｐ
4	重複	客先	機種	数量	数量	数量	数量
5	aaaa	あいう	aaaa	100	200	300	400
6		かきく	bbbb	100	200	300	400
7	新規	さしす	kkkk	100	200	300	400
8	新規	たちつ	pppp	100	200	300	400
9	新規	まみむ	vvvv	100	200	300	400
10	新規	は	eeee	100	200	300	400
11							
 の様に成りそうに思います。

 それとも、処理前が

 処理前2							
	A	Ｃ	Ｄ	Ｊ	Ｌ	Ｎ	Ｐ
4	重複	客先	機種	数量	数量	数量	数量
5		あいう	aaaa				
6		あいう	aaaa				
7		かきく	bbbb				
8

 なんでしょうか？

 (HANA)

 専用フォームはB～Nまでしかデータが入っていません。
 客先と機種名のデータは一切無視してください。
 客先かつ機種名が一致するものの、一番下の数量だけが入っていければいいのですが。
 A列には機種名を入れていき、確認がわからないのはこちらで他の資料をみながら
 確認するのでここも無視してください。
 目的は、客先と機種で数量をあわせこみだけです。
 それと同時にどのぐらい同じ機種で重複し、新規機種があるのかです。
 処理後２で大丈夫です。

 ご指摘で気がついたのですが、新規のものに関しても、”新規”ではなく機種名を
 表示いただけませすか？
 新規のものは表の罫線からはずれますので判断できるなと気がつきました。

 >専用フォームの方は　客先「AAA」機種「K-111」と言う項目は事前に一つしか登録されていないのですよね？
 　　でないと、複数有った場合「いずれかの数量が入っていればいい」と言う表現は適さない様に思えますので。
　
 客先「AAA」機種「K-111」までは同じで、品番が違うという場合もあります。
データの方は品番がなく客先と機種のみしか共通項目がないので
あいまいな検索になってしまいますが、イチからやるよりずっと助かります。

 ＞目的は、客先と機種で数量をあわせこみだけです。
 ＞それと同時にどのぐらい同じ機種で重複し、新規機種があるのかです。

 でしたら、重複しているデータは数量を合算
 何件重複しているのか表示
 する方が状況に合いそうに思いますが。。。

 一旦コードを載せてみます。
 結合部分は、上の値が入っている物として扱うのか
 合算（？）後として扱うのか良く分からないので
 「値が入っていない」ものとして処理しています。

 まずは、動かしてみて　結果は希望と違うと思いますので
 どう成っている物がどうなってくれると良いのか
 具体的に例をあげて教えて貰えると良いと思います。

 同じブックでのコードにしてあるので
 専用フォームのシートと、データのシートは同じブックに入れて
 シート名を「フォーム」「データ」に変更してください。

 コードの下の方でコメントアウトしてある部分が有りますが
 この部分が「重複・新規はA列に機種名を表示」をする部分です。
 このまま（コメントアウトのまま）動かした場合
 A列に何件有ったか、件数が出ます。
 オートフィルタで絞り込む際、A列が1以上でB列(等)に入力が無い行が新規。
 A列が2以上で、B列(等)に入力が有るものが、既定で重複が有るものに成ります。

 '------
Sub TEST1()
Dim MyArr As Variant
Dim MyFormSh As Variant, MyDataSh As Variant
Dim i As Long, MyRow As Long, MxRow As Long, EdRow As Long
Dim MyKy As String
Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set MyFormSh = Sheets("フォーム")
    Set MyDataSh = Sheets("データ")
MyArr = Array("H", "L", "P", "J", "L", "N")
With MyFormSh
    MxRow = .Range("C" & Rows.Count).End(xlUp).Row
    EdRow = MxRow
    For i = 5 To MxRow
        dic(.Range("C" & i).Value & "_" & .Range("D" & i).Value) = i
    Next
End With
With MyDataSh
    For i = 8 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("B" & i).Value <> "" Then
            If .Range(MyArr(1) & i).Value + .Range(MyArr(2) & i).Value + .Range(MyArr(3) & i).Value <> 0 Then
                MyKy = .Range("B" & i).Value & "_" & .Range("C" & i).Value
                If Not dic.Exists(MyKy) Then
                    EdRow = EdRow + 1
                    dic(MyKy) = EdRow
                    MyFormSh.Range("C" & EdRow).Value = .Range("B" & i).Value
                    MyFormSh.Range("D" & EdRow).Value = .Range("C" & i).Value
                End If
                    MyRow = dic(MyKy)
                    MyFormSh.Range("A" & MyRow).Value = MyFormSh.Range("A" & MyRow) + 1
                    MyFormSh.Range(MyArr(3) & MyRow).Value = .Range(MyArr(0) & i).Value
                    MyFormSh.Range(MyArr(4) & MyRow).Value = .Range(MyArr(1) & i).Value
                    MyFormSh.Range(MyArr(5) & MyRow).Value = .Range(MyArr(2) & i).Value
            End If
        End If
    Next
End With
'With MyFormSh
'    For i = 5 To EdRow
'        If i <= MxRow And .Range("A" & i).Value > 1 Then
'            .Range("A" & i).Value = .Range("D" & i).Value
'        ElseIf i > MxRow And .Range("A" & i).Value > 0 Then
'            .Range("A" & i).Value = .Range("D" & i).Value
'        Else
'            .Range("A" & i).ClearContents
'        End If
'    Next
'End With
    Set dic = Nothing
    Set MyFormSh = Nothing
    Set MyDataSh = Nothing
End Sub
 '------

 (HANA)

 HANAさん

 ありがとうございます。
 イメージどおりです！

 あと追加のお願いなのですが、データのA社～E社まで除外したい場合は
 どうすればいいでしょうか？

 これで良かったですか？

 でしたら、除外の前に先に A,Bデータシートと専用フォームに関しても
 もう一度詳しく教えてもらえますか？
 順番としては、↑はCデータシート用のコードなので
 　１．出来れば３つに共通にしたい
 　２．違うブックで実行出来る様にしたい
 　最後に．除外する客先を踏まえたコードにする
 のが良いと思いますので。

 TEST1のコードは
 MyArr = Array("H", "L", "P", "J", "L", "N")
 この部分で、H列→J列、L列→L列、Ｐ列→N列の様に　前側3文字と後側3文字を対応させて居ます。

 Aシートと、Bシートではそれぞれどの様に対応させるのか。
 また、その他の部分はCシートと比べてどの様に違うのか。
 それから、データを見た時に、A,B,Cいずれのシートなのか何処で判定出来るか。
 もし、A,B専用フォームとC専用フォームで列が違う様で有れば　何処に何の列が有るか。

 教えて下さい。

 (HANA)

 すみません、その前に
 A列の重複ですが、同じ機種なのにカウントした数が違っているものがあります。
 同じ品番はひとつしかないのに２とでてるものもありますし、
 重複の3つあるうちの２つは3で、もうひとつは5とでています。

 3つのファイルの違いですが、ＡとＢはアメリカ用、Ｃはイギリス用とわかれています。	
 ファイル名にその文字が入っていますのでそれで見分けています。
 先ほどのと違う点は、列が違うのと、結合部分が客先・機種名・数量と増えます
 列が違うのは列ごと削除して先ほどのＣファイルとあわせてしまってかまいません。

  　１．出来れば３つに共通にしたい	
	⇒ＡとＢのファイルは列をＩＪ列、ＭＮ列を削除して、
	Ｃ用とフォーマットをあわせる。

  　２．違うブックで実行出来る様にしたい	
	⇒専用フォームごとに可能ですか？（アメリカ用とイギリス用）				
	アメリカ用フォームはＡとＢの情報がまざって入っています								
 先ほどのコードと同じように専用フォームにＡとＢは
ワークシートのデータ1,データ2としてできますでしょうか？

  　３．専用フォｰムは先ほどのものと列は全部同じ。									
	⇒内容だけＡとＢ用になっています。

 下記表はＡとＢのファイルで列をＩＪ列、ＭＮ列を削除した状態のデータ									
	生産だけ１行ずつ表示してありで、Ｂ、Ｃ、Ｈ、Ｌ、Ｐは機種ごとに結合されています。

	B	C	D	E	F	G	H	Ｌ	Ｐ
6	客先	機種名	生産						
7				（）	計画	計画	数量	数量	数量
8	Ａ社	aaaa	北海道	10,000	0	0	0	0	0
9			青森	0	0	0			
10		bbbb	秋田	2,000	5,000	40,000	15,000	15000	15000

 たくさんご説明頂いていますが
 ＞同じ機種なのにカウントした数が違っているものがあります。
 の方から先に話を進めます。

 専用フォームの既定の項目（事前に入っているデータ）を一旦削除して
 やってみてもらえますか？

 全ての項目が転記されると思いますが　その際　A列の件数がどの様に成るか
 もう一度確認してみて下さい。

 データシートの T列にでも　=J7+L7+P7　の式を入れて下にフィルドラッグして下さい。
 0でない行がマッチングの対象行です。

 ピボットテーブル等で集計して、フォームシートのA列の件数と見比べてみてもらえると良いと思います。

 データシートのT列の見出しを「Sa1」とした場合
 　行のフィールド　「Sa1」「客先」「機種名」
 　データフィールド「客先」
 を入れて貰って、Sa1 で0以外を表示して貰うと、それぞれの件数が出ると思います。

 ちなみに、
 ＞Ｃデータファイル
 のデータとして載せて貰っている状態では
 数量を入れるセルが結合されていて、8行目にしか入力が無いので
 A会社_1111（8行目） はマッチングの対象ですが、B会社_2222（9行目） はマッチングの対象外に成ります。

 (HANA)

 申し訳ございません。。
 専用フォームのデータは削除することができません。
 専用フォームが親で、それをもとに足りないものや重複を探したいのです。

 機種名が一致しないものは対象外でお願いします。

 「テストの為に、一旦削除して下さい」と言う意味です。
 ブックを複製して貰って、複製した物で削除後テストして貰っても良いです。

 或いは、同じ問題が起きるデータと
 同じ問題を起こすための書式等をご提示下さい。
 そうして頂ければ、こちらでテスト出来ますので。

 不具合が有るのは、新規のものではなく　既定の物に関してのみなのでしょうか？
 　でしたら、全て新規にしてしまったら何の検証も出来ませんが。。。
 　ご説明からはどちらなのかよく分かりません。

 それから、「機種名が一致」と言う表現が何度か出てきますが
 客先と機種の2つの項目をキーにするのですよね？

 (HANA)

 データから専用フォームへ一致させるのは、機種名と客先の２つです。 
 重複は専用フォーム内で機種名のみ一致するものだけをＡ列にだします。
 私のイメージではCountifのようなカンジなのですが・・・

 先ほどすべての専用フォームにあるすべてのデータを消してみましたが
 1つしか機種名がなくても、２や７の数字がでてます。
 空白の行でも4や7や3がでています。

 元のデータに機種名と客先が一致するものが何件有ったか？
 ではなく、専用フォームに転記した物の内、同じ機種名のもの
 　（客先違いで、機種名が同じもの）が何件有ったか？

 が解りたいのですか？

 　重複　　客先　　 機種名
     2     A会社    1111
     2     B会社    1111
 と言った感じで。。。？

 でしたらまさに、COUNTIFが便利そうですね。
 '------
Sub TEST2()
Dim MyArr As Variant
Dim MyFormSh As Variant, MyDataSh As Variant
Dim i As Long, MyRow As Long, MxRow As Long, EdRow As Long
Dim MyKy As String
Dim dic As Object
    Set dic = CreateObject("scripting.dictionary")
    Set MyFormSh = Sheets("フォーム")
    Set MyDataSh = Sheets("データ")
MyArr = Array("H", "L", "P", "J", "L", "N")
With MyFormSh
    MxRow = .Range("C" & Rows.Count).End(xlUp).Row
    EdRow = MxRow
    For i = 5 To MxRow
        dic(.Range("C" & i).Value & "_" & .Range("D" & i).Value) = i
    Next
End With
With MyDataSh
    For i = 8 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("B" & i).Value <> "" Then
            If .Range(MyArr(1) & i).Value + .Range(MyArr(2) & i).Value + .Range(MyArr(3) & i).Value <> 0 Then
                MyKy = .Range("B" & i).Value & "_" & .Range("C" & i).Value
                If Not dic.Exists(MyKy) Then
                    EdRow = EdRow + 1
                    dic(MyKy) = EdRow
                    MyFormSh.Range("C" & EdRow).Value = .Range("B" & i).Value
                    MyFormSh.Range("D" & EdRow).Value = .Range("C" & i).Value
                End If
                    MyRow = dic(MyKy)
                    MyFormSh.Range(MyArr(3) & MyRow).Value = .Range(MyArr(0) & i).Value
                    MyFormSh.Range(MyArr(4) & MyRow).Value = .Range(MyArr(1) & i).Value
                    MyFormSh.Range(MyArr(5) & MyRow).Value = .Range(MyArr(2) & i).Value
            End If
        End If
    Next
End With
With MyFormSh
    .Range("A5:A" & EdRow).Value = "=IF(COUNTIF($D$5:$D$" & EdRow & ",D5)>1,COUNTIF($D$5:$D$" & EdRow & ",D5),"""")"
    .Range("A5:A" & EdRow).Value = .Range("A5:A" & EdRow).Value
End With
    Set dic = Nothing
    Set MyFormSh = Nothing
    Set MyDataSh = Nothing
End Sub
 '------

 こんなので大丈夫ですか？

 ＞空白の行でも
 ってのがちょっとよく分からないですが。。。

 (HANA)

 ご連絡おそくなりました。

 大丈夫でした！！

 もうひとつの2つあるデータの方もお願いできますでしょうか？

 データ1とデータ2とフォームの３シートになりますか？

 また説明が不足していましたら、ご指摘ください。

 よろしくおねがいします。

 大丈夫でしたか、でしたら
 シート名や、シートを見分けられるセル番地とその内容や
 それぞれのファイル名等　教えて下さい。

 ＞列が違うのは列ごと削除して先ほどのＣファイルとあわせてしまってかまいません。
 と言う提案を頂いていますが、出来ればその辺りはつつかずに済む方が
 面倒が無くて良いと思います。

 また、現在のコードは　フォームシートとデータシートを同じファイルに入れて実行しますが
 この場合、データをコピーする操作が必要に成ってくると思います。
 毎回やるのも面倒なので、出来れば二つ（或いは三つ）のファイルを開いて実行したら
 結果が出るように出来れば良いと思いっています。

 ＞3つのファイルの違いですが、ＡとＢはアメリカ用、Ｃはイギリス用とわかれています。	
 ＞ファイル名にその文字が入っていますのでそれで見分けています。
 と言う事ですが、具体的にどの様なファイル名が付くのでしょう？

 また、シート名は固定でしょうか？どう言った物が付いていますか？

 ＞下記表はＡとＢのファイルで列をＩＪ列、ＭＮ列を削除した状態のデータ
 を載せて下さっていますが、I,J,M,N列を削除しなかった場合、Ｃデータの時にご説明頂いた
 ＞＞データファイルのＨ列の販売計画を⇒Ｊ列へ、Ｌ列をＬ列へ、Ｐ列をＮ列へ転記	
 の様に表現すると、どの様に成りますか？

 それから、
6	客先	機種名	生産						
7				（）	計画	計画	数量	数量	数量
8	Ａ社	aaaa	北海道	10,000	0	0	0	0	0
9			青森	0	0	0			
10		bbbb	秋田	2,000	5,000	40,000	15,000	15000	15000
 のデータは、結合を解除した場合　どの様に読めば良いでしょう？

 結合されているセルは、エクセル的には何も入っていないので↑のデータの場合
 処理対象行が無い事に成ります。
 　8行目は数量が「0」なので処理対象外
 　9,10行目は　客先_機種名　の二つのセルにデータが揃って無いので　処理対象外

 (HANA)

 ご回答ありがとうございます。

 ・ファイル名

 イギリス１１月度（中）
 イギリス１１月度（小）

 アメリカ１１月度

 ・シート名
 全ファイル共通で"まとめ"

 ・結合
 ご指摘の通り結合解除後、結合の上のセルだけにデータがはいるので
 機種名が空白になった部分は対象外で大丈夫です。
 二つのセルにデータが揃っているものだけとなります。
 ただ、客先は結合範囲分のセル全部に客先名を認識させないと
 ダメだと思うのですが、次の客先のところまでコピー？など
 どうなりますでしょうか？ 
 1つの客先に、機種名が10個ぐらいあるところもあります。

 ・データの書式
 交渉してフォームを揃えてもらうことができたのですが、運用が
 いつになるか決まっていません。
 運用が始まるまでは、Ｃ用のファイルにあわせて列を削除して
 おきますので、フォームを改定した前提で作っていただいてかまいません。

 ・専用フォームのファイル名
 ファイル名・・・専用シート（Ｅ）、専用シート（Ａ）
 シート名・・・ふたつとも"Sheet1"

 ・除外したい会社名：5個以上あります。

 いろいろお手数おかけしますがよろしくおねがいします。

 ＞客先は結合範囲分のセル全部に客先名を認識
 ＞交渉してフォームを揃えてもらうことができたのですが
 これは何とかなると思います。

 もう一つ教えて下さい。

 データファイル名の「国名」や「○月度」と言うのは
 専用フォームのどこかに情報が有りますか？

 専用フォームのファイル名に「E」が有ったらイギリスで「A」が有ったら　アメリカ
 っぽいですが、同様に　Sheet1のA1セルに日付が入っていてその月の月度　とか有れば
 それを利用出来るのですが。。。

 それから、E,A,11,()等、ファイル名は全て全角ですか？

 (HANA)

 専用フォームもデータのファイル名も、半角でそれぞれA、Eと入っています。
 ファイル名に含まれる月の部分も半角数字です。

 専用フォームはそれぞれ、Ｂ2セルにＡ数量管理表、E数量管理表と題名が打ってあります。

 これぐらいで大丈夫でしょうか？
 よろしくお願いします。

 こんな感じで大丈夫でしょうか？

 処理対象外の社名は
 JgKsN = "D社_E社_F社"
 の所で、半角アンダーバーで区切りながら列挙して下さい。

 ファイル名・シート名等　固定と思われる所は直接文字で指定して有ります。
 もしもご説明のために変更している場合は、まずはファイル名・シート名の方を
 ご説明の通りに合わせて、実行してみて下さい。
 　　結果を確認後、コードを実際に合わせて下さい。

 マクロの実行は専用フォームのファイルと、データのファイル（イギリスは2つ）を開き
 専用フォームのシートをアクティブにした状態で、実行して下さい。

 '------
Sub TEST3()
Dim MyArrD As Variant, MyArrF As Variant
Dim MyDataBk As Variant
Dim i As Long, MyRow As Long, EdRow As Long
Dim MyKsm As String, JgKsN As String, TsBkN As String
Dim dic As Object, MyKy As String
    Set dic = CreateObject("scripting.dictionary")
MyArrD = Array("H", "L", "P")   '←データシートの列
MyArrF = Array("J", "L", "N")   '←対応するフォームの列
JgKsN = "D社_E社_F社"           '←処理対象外の社名

    If Left(Range("B2").Value, 1) = "A" Then
        TsBkN = "アメリカ"
    ElseIf Left(Range("B2").Value, 1) = "E" Then
        TsBkN = "イギリス"
    Else
        MsgBox "フォームシートをアクティブにして実行して下さい。"
        Exit Sub
    End If

    EdRow = Range("C" & Rows.Count).End(xlUp).Row
    For i = 5 To EdRow
        dic(Range("C" & i).Value & "_" & Range("D" & i).Value) = i
    Next

    For Each MyDataBk In Workbooks
        If MyDataBk.Name <> ActiveWorkbook.Name And MyDataBk.Name Like TsBkN & "*月度*" Then
            With MyDataBk.Sheets("まとめ")
                For i = 8 To .Range("D" & Rows.Count).End(xlUp).Row
                    If .Range("B" & i).Value <> "" Then
                        MyKsm = .Range("B" & i).Value
                    End If
                    If Not "_" & JgKsN & "_" Like "*_" & MyKsm & "_*" Then
                        If .Range("C" & i).Value <> "" Then
                            If .Range(MyArr(1) & i).Value + .Range(MyArr(2) & i).Value + .Range(MyArr(3) & i).Value <> 0 Then
                                MyKy = MyKsm & "_" & .Range("C" & i).Value
                                If Not dic.Exists(MyKy) Then
                                    EdRow = EdRow + 1
                                    dic(MyKy) = EdRow
                                    Range("C" & EdRow).Value = MyKsm
                                    Range("D" & EdRow).Value = .Range("C" & i).Value
                                End If
                                    MyRow = dic(MyKy)
                                    Range(MyArrF(0) & MyRow).Value = .Range(MyArrD(0) & i).Value
                                    Range(MyArrF(1) & MyRow).Value = .Range(MyArrD(1) & i).Value
                                    Range(MyArrF(2) & MyRow).Value = .Range(MyArrD(2) & i).Value
                            End If
                        End If
                    End If
                Next
            End With
        End If
    Next

    Range("A5:A" & EdRow).Value = "=IF(COUNTIF($D$5:$D$" & EdRow & ",D5)>1,COUNTIF($D$5:$D$" & EdRow & ",D5),"""")"
    Range("A5:A" & EdRow).Value = Range("A5:A" & EdRow).Value

    Set dic = Nothing
End Sub
 '------

 (HANA)

 お返事がまだ無い様なので、転記列の対応をもう少し象徴的にしてみました。
 既にコードをコピー＆テストをして居られましたら
 お手数ですが　もう一度やってみてもらえると良いと思います。

 上手く動きましたら、新フォームで届く迄は
MyArrD = Array("H", "L", "P")   '←データシートの列
 を書き替えた物をもう一つ作っておいても良いかもしれません。

 もしもイギリスの(中)(小)でも列が違う場合は、コードを３パターン用意して
 　Eフォーム＆(中)データを開いた状態で、(中)用コードを実行。
 　その後、(中)データを閉じ、(小)データを開いた状態で、(小)用コードを実行。
 でも良いかもしれません。

 (HANA)

 ご連絡遅くなり申し訳ございません

 基本的な質問でお恥ずかしいのですが

 1.コードはどこへ張り付ければよろしいでしょうか？
 2.フォームをアクティブとはどのような状態でしょうか？

 すべて5つのファイルを開いて実行でよろしかったでしょうか？

 ＞ 1.コードはどこへ張り付ければよろしいでしょうか？

 コードは何処でも良いですが。。。それぞれのブックは
 どの様にしてはぐさんの手に渡るのでしょう？

  ◆Ａデータファイル、Ｂデータファイル　⇒　ＡＢデータが合体している専用フォーム
 の場合
 　Ａデータ・・・・・イギリス11月度(中) ブックの「まとめ」シート
 　Ｂデータ・・・・・イギリス11月度(小) ブックの「まとめ」シート
 　専用フォーム・・・専用シート(E) ブックの「Sheet1」シート

 イギリス11月度(中) ブック と　イギリス11月度(小) ブック　は
 毎月各支店からブック毎データが送られてくるのですよね？
 すると、コードを入れるなら　毎月入れないといけない事に成りますね。

 専用フォームの方はどうなんでしょう？
 Sheet1 のデータも毎月更新されるような印象が有りますが。。。

 ブック自体が入れ替わるなら、このブックにもマクロを入れておけないですね。
 データだけが入れ替わるなら、マクロはこのブックで良いと思いますが。
 ただ、専用フォームは二つあるので。。。
 取り敢えず、マクロだけが入ったブックを作ってみて下さい。
 　（仮にブック名。転記マクロ.xls）

 ＞2.フォームをアクティブとはどのような状態でしょうか？

 専用シート(E) ブックの「Sheet1」シートが選択されている状態
 （一番前面に表示されている状態。何か入力したら　このシートのセルに入力される状態）
 です。

 ＞すべて5つのファイルを開いて実行でよろしかったでしょうか？
 開いてある事自体は問題無いと思いますが、まずは 
 　イギリス11月度(中).xls
 　イギリス11月度(小).xls
 　専用シート(E).xls
 　転記マクロ.xls
 の4つのブックだけにしてやってみて下さい。

 実際のファイル名が↑と違う場合（特にデータの有るブック名）は
 ↑の名前と合わせてから実行して下さい。

 専用シート(E).xls の Sheet1 をアクティブに（選択）した状態で
 Alt + F8 を押して、TEST3コードを選び　実行して下さい。

 (HANA)

 ご報告遅くなりすみません

 おっしゃるとおり、３つのデータは各支店から、専用フォームは毎月内容が変わります。

 新しいブックでコードを張り付けて、実行してみたのですが・・・
 何も変化がおきません。。
 エラーが起きるわけでもありませんし、専用フォームに何か数字が入っているわけでもありません。
 でもアクティブにしてください。というメッセージはでています。
 ブック名なども確認しましたし、列などもそろえたのですが 
 こちらに不備があるのだと思うのですが明日また確認しご報告いたします。

 専用フォームのブックがアクティブに成っているかどうかは
 ＞ 専用フォームはそれぞれ、Ｂ2セルにＡ数量管理表、E数量管理表と題名が打ってあります。
 このご説明から判断して居ます。

 今は
 ＞＞専用シート(E).xls の Sheet1 をアクティブに（選択）した状態で
 やって貰っていますので、B2セルに「E数量管理表」と言う文字が入っていない場合
 そのメッセージが表示されます。

 専用シート(E).xls ＝ 専用フォームのブック（イギリス用）の事です。

 実際は、B2セルには何と入力されているのでしょう？
 もしかして、「A2:B2セルが結合されている」なんて事は無いですか？
 アルファベットは全角でしょうか、半角でしょうか？
 専用フォームのシートのどのセルに何が入力されているか　もう一度確認してみてもらえると
 良いのではないかと思います。

 　海外の支店とやりとりをするのに、ブック名などが日本語と言うのに少し違和感が有りますので
 　こちらへ説明文を載せる際に　分かりやすい様に変更して居られるのではないかと思っています。
 　実際のファイル名・シート名・内容　を教えていただけると
 　＞＞実際のファイル名が～～↑の名前と合わせてから実行して下さい。
 　なんて作業をして貰わなくて済むので良いと思うのですが。

 (HANA)

フォームのB2は結合ありませんでした。

 下記へB2の題名を全部貼付けてみたりしましたが
 Msgがでてしまいました。

    If Left(Range("B2").Value, 1) = "E数量管理表 (2011年11月～2012年02月)" Then
        TsBkN = "E"

 先日わかりやすいようにファイル名を全角カタカナで書きましたが
 アルファベットから始まっています。
 ファイル名
 E11月度会議（中）
 E11月度会議（小）
 A11月度会議

 ただ、データの（B2:S2)、(B3:S3）は題名のために結合されていました
 データは８行目から、H8、L8、P8で始まります

 中間すぎぐらいの下記コードですか、MyArrDでよかったでしょうか？
 If .Range(MyArrD(1) & i).Value + .Range(MyArrD(2) & i).Value + .Range(MyArrD(3) & i).Value <> 0 Then

 Msg と言うのは
 「フォームシートをアクティブにして実行して下さい。」
 ですよね？

 ＞下記へB2の題名を全部貼付けてみたりしましたが
 それは確実に不一致になりますね。。。

 ぱぐさんが思っている　アクティブシートのB2セルの値　と
 エクセルで見ている　アクティブシートのB2セルの値　が
 違っているかもしれません。

 因みにコードは、何処に書いてありますか？
 転記マクロ.xlsの標準モジュールに入れて下さい。

 一応↓を実行してみて、何と表示されるか教えてもらえますか？
 表示したメッセージをA1セルに書き出します。
 コピーして、こちらへ貼り付けてもらえると良いと思います。
    Sub 確認1()
    Dim TsBkN As String, Msg As String
        Msg = Range("B2").Value
        TsBkN = Left(Msg, 1)
        Msg = Msg & vbLf & TsBkN & "・" & (TsBkN = "E") & "・" & (TsBkN = "Ｅ")
        MsgBox Msg
        Range("A1").Value = Msg
    End Sub

 (HANA)

 お手数おかけして申し訳ございません
 コードは転記マクロ.xlsの標準モジュールのところです。

 Sub 確認1() のマクロをためしてみたところ、

 A1のセルに "E数量管理表 (2011年11月～2012年02月)H・False・False"
とでていました。

 ？？
 A2セルに
 =LEFT(B2,1)
 の式を入れると　何が表示されますか？？

 (HANA)

半角のEという文字がでました。

 やっぱり変ですね。

 フォームシートのB2セルに　半角の大文字のE　に打ち直して
 　（E のみ入力されている状態にして下さい）
 確認1のマクロをもう一度実行してみてもらえますか？

 (HANA)

 B2の表題をEだけに打ち直してみた結果です。
 最初のEのあと、セル内で改行？みたいになっているようでした。

 E
 E・False・False

 はい、最初のEのあとは、改行が一つ入れてあります。

 それにしても、False,False なんですね。。。
 何でですかねぇ。

 もっと単純に、これではどうですか？
    Sub 確認2()
    Dim TsBkN As String
        TsBkN = Range("B2").Value
        MsgBox (Range("B2").Value = "E") & "・" & (TsBkN = "E")
    End Sub

 因みに、全く新しいブックで試して貰うとどうなんでしょう？

 (HANA)

 こんなカンジです。
 ・False・False

 やはりFalseがでてきました。。

 新規ブックで試した場合は 逆になりまして
　・True・True　です

 ファイル名などの問題なのでしょうか？

 ファイル名などが問題なのか
 シートに問題があるのか、ブックに問題が有るのか。。。

 フォームのブックに、新しいシートを挿入してやってみると
 どうでしょう？
 これで　確認2 で True・True に成る様で有れば内容を新しいシートに移してみて下さい。

 フォームのブックは、わりと新しいブックなのでしょうか？
 それとも、昔から使い続けているブックなのでしょうか？

 新しいブックへ作り替える事が難しいのでなければ
 一旦新しいブックへ同じ様な物を作って試してみてもらえると良いと思います。

 (HANA)

 このフォーム自体は毎月システムから出力されるもので使いこんでいるような
 古いファイルではありません

 True・Trueとでたフォームですすめてみたところ
 下記のコードあたりで実行時エラーがでました。

 実行時エラー
 "インデックスが有効範囲にない"

 If .Range(MyArrD(1) & i).Value + .Range(MyArrD(2) & i).Value + .Range(MyArrD(3) & i).Value <> 0 Then

 カーソルをあててみると、コメントがでていました。
 MyArryD(1)="L"
 MyArryD(2)="P"
 MyArryD(3)=<インデックスが有効範囲にありません＞

 というカンジです。Ｈ列がないと言ってるのですか？

 「システムから出力される」って事で何か有るのかも知れないですね。。。

 ＞"インデックスが有効範囲にない"
 あぁ、スミマセン。
 修正するのを忘れてました。（と言うか、最初から間違ってましたね。。。）
 0,1,2にして下さい。

 If .Range(MyArrD(0) & i).Value + .Range(MyArrD(1) & i).Value + .Range(MyArrD(2) & i).Value <> 0 Then

 最初の方に↓が有りますが、MyArrDの中の位置（番号）になります。
 MyArrD = Array("H", "L", "P")   '←データシートの列
                 0    1    2
                ↑0から始まる。
　MyArrD(0) = "H"
  MyArrD(1) = "L"
  MyArrD(2) = "P"
　MyArrD(3) ←無いので、エラーになる。

 (HANA)

データの移行、両方ともできました！
本当にありがとうございます。

そこで可能であれば、お願いしたいことがあります。

【フォーム】

 ・SとAの完全一致ではなく、この単語を含む…に変更してほしい
 　題名が"E数量管理表 (2011年11月～2012年02月)"こんなかんじです

    If Left(Range("B2").Value, 1) = "S" Then 
        TsBkN = ""
    ElseIf Left(Range("B2").Value, 1) = "A" Then 
        TsBkN = ""

 ・J2、L2、N2セルに　数量のSubtotal関数を追加

 【データファイル】

 ・Ｂ列の客先、ある客先の表記を置換えたい
 　例："PANDA"→"パンダ"

 ・機種(D列)半角4文字のみで検索したい
	４文字以外に余計な文字が入っているものがあります。それを消したい

 　正しい例→aaaa　 
   ダメな例×→aaaa(1234)、aaaa新規　など

 よろしくおねがいします。

 【フォーム】
 ＞・SとAの完全一致ではなく、この単語を含む…に変更してほしい

 元々完全一致では無いのですが。。。
 題名として他にどんなパターンが有って　どう言った時にどうしたいのか
 具体的に教えて下さい。

 ＞・J2、L2、N2セルに　数量のSubtotal関数を追加
 普通に合計で良いのですか？

 【データファイル】
 ＞・Ｂ列の客先、ある客先の表記を置換えたい
 何件くらい有りますか？
 また、その場合　フォームの方の客先はどうなっているのでしょう？
 　（フォームの客先と合わせる為に置換が必要なのかな。。。？）

 システムから出力されるブックでそのままマクロを実行した場合
 もしも最初の判定だけが問題で　その後の処理に問題が無いのなら
 最初の判定は別の方法を考えれば良いと思っていますが。

 (HANA)

【フォーム】

 ＞・SとAの完全一致ではなく、この単語を含む…に変更してほしい

 そうですか・・・
 題名は１パターンしかありません
 "■AAA-England数量管理表"と
 "■AAA-AMERICA数量管理表"となっています。

 B2が"E"一文字でないと”フォームをアクティブにしてください”のメッセージがでます。
 題名がEだけだと、問題なく答えがでているので不思議です。

 ＞・J2、L2、N2セルに　数量のSubtotal関数を追加
 普通に合計で良いのですか？

 HANAさんのを見ながら自分なりに考えてやってみました。
    Range("J2").Value = "=Subtotal(9,$J$5:$J$" & EdRow & ")"
    Range("L2").Value = "=Subtotal(9,$L$5:$L$" & EdRow & ")"
    Range("N2").Value = "=Subtotal(9,$N$5:$N$" & EdRow & ")"

 【データファイル】
 ＞・Ｂ列の客先、ある客先の表記を置換えたい
 何件くらい有りますか？
 また、その場合　フォームの方の客先はどうなっているのでしょう？
 　（フォームの客先と合わせる為に置換が必要なのかな。。。？）

 そうなんです。フォームとデータの客先の表記が違うので、新規として転記されてしまいます。
 RINGOみたいにアルファベットです。それをフォームではリンゴとカタカナになっています。
 この置換えは、1件しかありません。

 データファイルの表記と機種名の４桁は、今後フォームを統一したときに
 改善してもらうつもりでおりますが、いつになるのかわからない状況です・・・

 ＞題名がEだけだと、問題なく答えがでているので不思議です。
 これは、システムから出力されたブックを使った場合もそうですか？

 当初のご説明では
 ＞専用フォームはそれぞれ、Ｂ2セルにＡ数量管理表、E数量管理表と題名が打ってあります。
 と言う事だったので、処理としては
    If Left(Range("B2").Value, 1) = "A" Then
    ElseIf Left(Range("B2").Value, 1) = "E" Then
 左から1文字目を取り出して、そのアルファベットがAだったら・・・Eだったら・・・

 と言う判定にして居ました。

 もしもB2セルが"■AAA-England数量管理表"と入っているなら
 左から1文字目は　■　で、AでもEでもないので
 　－－別のシートをアクティブにして実行したな
 と判断し「フォームをアクティブにしてください」とメッセージが出ます。

 間違えてフォーム以外のシートをアクティブにしていた場合で
 たまたまB2セルに England と言う文字を含んでいた場合
 この判定が用を成さない事に成ってしまいます。

 B2セルに England と言う文字を含むシートはこのシート以外存在しない
 と言う事なら、それでも良いでしょうけど。

 ＞HANAさんのを見ながら自分なりに考えてやってみました。
 これは良いと思います。
 ↓の中にコピーさせて貰いました。

 って事で、コードを載せてみます。
 テストしてませんので、エラーが出る場合は　エラーが出る場所と
 エラーメッセージを合わせて教えて下さい。

 '------
Sub TEST4()
Dim MyArrD As Variant, MyArrF As Variant
Dim MyDataBk As Variant
Dim i As Long, MyRow As Long, EdRow As Long
Dim MyKsm As String, JgKsN As String, TsBkN As String
Dim CkKsN As Variant
Dim dic As Object, MyKy As String
    Set dic = CreateObject("scripting.dictionary")
MyArrD = Array("H", "L", "P")       '←データシートの列
MyArrF = Array("J", "L", "N")       '←対応するフォームの列
JgKsN = "D社_E社_F社"               '←処理対象外の社名
CkKsN = Array("RINGO", "リンゴ")    '←置き換える社名

    If Range("B2").Value Like "*" & AMERICA & "*" Then
        TsBkN = "アメリカ"
    ElseIf Range("B2").Value Like "*" & England & "*" Then
        TsBkN = "イギリス"
    Else
        MsgBox "フォームシートをアクティブにして実行して下さい。"
        Exit Sub
    End If

    EdRow = Range("C" & Rows.Count).End(xlUp).Row
    For i = 5 To EdRow
        dic(Range("C" & i).Value & "_" & Range("D" & i).Value) = i
    Next

    For Each MyDataBk In Workbooks
        If MyDataBk.Name <> ActiveWorkbook.Name And MyDataBk.Name Like TsBkN & "*月度*" Then
            With MyDataBk.Sheets("まとめ")
                For i = 8 To .Range("D" & Rows.Count).End(xlUp).Row
                    If .Range("B" & i).Value <> "" Then
                        MyKsm = .Range("B" & i).Value
                        If MyKsm = CkKsN(0) Then
                            MyKsm = CkKsN(1)
                        End If
                    End If
                    If Not "_" & JgKsN & "_" Like "*_" & MyKsm & "_*" Then
                        If .Range("C" & i).Value <> "" Then
                            If .Range(MyArr(0) & i).Value + .Range(MyArr(1) & i).Value + .Range(MyArr(2) & i).Value <> 0 Then
                                MyKy = MyKsm & "_" & Left(.Range("C" & i).Value, 4)
                                If Not dic.Exists(MyKy) Then
                                    EdRow = EdRow + 1
                                    dic(MyKy) = EdRow
                                    Range("C" & EdRow).Value = MyKsm
                                    Range("D" & EdRow).Value = Left(.Range("C" & i).Value, 4)
                                End If
                                    MyRow = dic(MyKy)
                                    Range(MyArrF(0) & MyRow).Value = .Range(MyArrD(0) & i).Value
                                    Range(MyArrF(1) & MyRow).Value = .Range(MyArrD(1) & i).Value
                                    Range(MyArrF(2) & MyRow).Value = .Range(MyArrD(2) & i).Value
                            End If
                        End If
                    End If
                Next
            End With
        End If
    Next

    Range("A5:A" & EdRow).Value = "=IF(COUNTIF($D$5:$D$" & EdRow & ",D5)>1,COUNTIF($D$5:$D$" & EdRow & ",D5),"""")"
    Range("A5:A" & EdRow).Value = Range("A5:A" & EdRow).Value
    Range("J2").Value = "=Subtotal(9,$J$5:$J$" & EdRow & ")"
    Range("L2").Value = "=Subtotal(9,$L$5:$L$" & EdRow & ")"
    Range("N2").Value = "=Subtotal(9,$N$5:$N$" & EdRow & ")"

    Set dic = Nothing
End Sub
 '------

 (HANA)

 ご連絡遅くなりました。
 いま検証中ですが、問題なく希望通りに結果がでています。
 こんな大変なことできないと思い込んでおりましたが
 本当にありがとうございました。
 私も理解までは難しいですが勉強ができました。

 最終的には人が照合作業を行うのですよね？
 しばらくは注意して見てもらえると良いと思います。

 ちなみに、数量のSubtotal関数部分ですが
 こんな感じで一行にしても良いと思います。

    Range("J2,L2,N2").Value = "=Subtotal(9,J5:J" & EdRow & ")"

 これは、J2,L2,N2の3つのセルを選択した状態で
 J2セルに（例えば）=BUSTOTAL(9,J5:J10) の式を作り Ctrl + Enter で確定した感じです。

 J5:J10の部分が、相対参照で指定して有るので　L2セルにはL5:L10の範囲
 N2にはN5:N10の範囲の式が入ります。

 Range("A5:A" & EdRow).Value = "=IF(COUNTIF($D$5:$D$" & EdRow & ",D5)>1,COUNTIF($D$5:$D$" & EdRow & ",D5),"""")"
 この時の式は
 A5 =COUNTIF(D5:D10,D5)
 A6 =COUNTIF(D5:D10,D6)
 A7 =COUNTIF(D5:D10,D7)
 と、最初の引数（D5:D10）は絶対参照、二番目の引数は相対参照にしたかったので
    =COUNTIF($D$5:$D$10,D5)
 の様に「$」マークをつけてあります。

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20111117122023]] 『データ一致するものを転記』（ぱぐ） ページの最後に飛ぶ

[[20111117122023]]　『データ一致するものを転記』（ぱぐ）　ページの最後に飛ぶ