Excel VBA質問箱 IV

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

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


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

1713 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【72393】２つのシートのデータを照合し列が一致したら転記したい kiki 12/8/1(水) 23:50

【72394】Re:２つのシートのデータを照合し列が一致... UO3 12/8/2(木) 10:12

【72396】Re:２つのシートのデータを照合し列が一致... kiki 12/8/2(木) 22:12

【72395】Re:２つのシートのデータを照合し列が一致... ドカ 12/8/2(木) 14:28

【72397】Re:２つのシートのデータを照合し列が一致... kiki 12/8/2(木) 22:17

【72400】再:２つのシートのデータを照合し列が一致... kiki 12/8/6(月) 22:07

【72401】Re:再:２つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:23

【72407】Re:再:２つのシートのデータを照合し列が一... kiki 12/8/7(火) 20:48

【72420】Re:再:２つのシートのデータを照合し列が一... UO3 12/8/8(水) 21:02

【72427】Re:再:２つのシートのデータを照合し列が一... kiki 12/8/8(水) 22:21

【72402】Re:再:２つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:36

【72403】Re:再:２つのシートのデータを照合し列が一... UO3 12/8/7(火) 6:39

【72404】Re:再:２つのシートのデータを照合し列が一... ぶらっと 12/8/7(火) 10:09

【72409】Re:再:２つのシートのデータを照合し列が一... kiki 12/8/7(火) 20:54

【72405】Re:再:２つのシートのデータを照合し列が一... kanabun 12/8/7(火) 14:25

【72411】Re:再:２つのシートのデータを照合し列が一... kiki 12/8/7(火) 22:25

【72410】再：２つのシートのデータを照合し列が一致... kiki 12/8/7(火) 21:11

【72412】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 12:51

【72413】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 13:34

【72414】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 14:34

【72415】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 14:46

【72416】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 17:07

【72418】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 17:17

【72419】Re:再：２つのシートのデータを照合し列が... kiki 12/8/8(水) 20:41

【72422】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/8(水) 21:10

【72426】Re:再：２つのシートのデータを照合し列が... kiki 12/8/8(水) 22:13

【72430】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/9(木) 14:26

【72437】Re:再：２つのシートのデータを照合し列が... kiki 12/8/9(木) 23:21

【72439】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/10(金) 9:18

【72421】Re:再：２つのシートのデータを照合し列が... kiki 12/8/8(水) 21:06

【72431】Re:再：２つのシートのデータを照合し列が... kanabun 12/8/9(木) 14:42

【72438】Re:再：２つのシートのデータを照合し列が... kiki 12/8/9(木) 23:22


	【72393】２つのシートのデータを照合し列が一致し...

kiki - 12/8/1(水) 23:50 -


	引用なし

	パスワード

VBA初心者です。
現在、突然仕事でVBAを使う仕事を任され困っています。
本を買って勉強し試行錯誤でコードを記載しているのですが、具体的にどうコードを記述していいか詰まってしまったためお知恵を拝借出来ればとの次第です。
ネットでも検索しているのですが、少し私の内容と異なっているためうまく当てはめられませんでした。

VBAでやりたいことは下記のようなことです。Excel2003を使っています。

1.ファイルを自動で読み込み、データを抽出する。←ここは出来ました
2.抽出したデータ「シート1」を「シート２」のデータ(表形式)と照合し、特定の列のコード内容が一致したら、シート２の右欄にシート１の抽出した他のデータを記載したい。

つまっているのは2.の部分です。
具体的に言いますと、

シート1
　　A列 B列 c列　　D列 E列 F列 G列・・・と30列ほど続きます。

　　aaa　 1/1　あああ　a-1　0　　 0　　0
　　bbb　 2/3　いいい　b-2　3000　0　　0
　　ccc　 7/2　ううう　c-3　900　 0　　0
　　ddd　 6/4　えええ　d-4　100　 200　300
シート2 表形式
　　A列 B列 c列　D列 E列 F列 G列・・・ｼｰﾄ1の項目分＋手動で記載する部分

　　a-1
　　b-2
　　c-3
　　d-4
シート2のA列の右欄が空欄になっているので、シート2のA列とシート1のD列を照合して一致している場合、シート1の各データをシート2のc列から右に転記したいです。ｂ列は手動で記載したいのでCから転記となります。(もしかすると転記場所は変わるかもしれませんが）

このような場合は、どのようなコードを記載するのがよいのでしょうか？
本を読んでもこういった場合の具体例がなく困っています。

マクロ記録を利用してVLOOKUP関数(私は使用したことがないのですが)などを使ったコードを組み込めばいいのでしょうか？
ただ、使用データは毎回変わるのでそれでも大丈夫なのか、それとも他のいいコードがあるのかも・・と悩み手がつけられず困っている次第です。

ちなみに、シート2に表を作成してマクロボタンを設置し、シート2のA列にコードを入力してからマクロを起動させると自動でファイルを読み込みデータ抽出してさらに二つのシートを比較してシート2のセルへ転記させる・・・ようなものを作りたいと思っています。
最終的にはシート2の表を毎月作成しなければなりませんのでそれを自動化したいのです。

もしかするともっといいやり方があるのかもしれませんが、私なりに調べてこれならば出来るのではないかと思ってチャレンジしています。

お手数お掛け致しますが、ご回答頂けますと幸いです。


	【72394】Re:２つのシートのデータを照合し列が一...

UO3 - 12/8/2(木) 10:12 -


	引用なし

	パスワード

▼kiki さん：

おはようございます。

ht p://www.excel.studio-kazu.jp/kw/20120801223824.html

あちらも、こちらも、マルチは【絶対禁止】というわけではないようですが、
こちらの基本方針に、以下のようなことが掲載されています。
ご参考まで。

【以下、こちらの基本方針から引用】

マルチポストについて
別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。


	【72395】Re:２つのシートのデータを照合し列が一...

ドカ - 12/8/2(木) 14:28 -


	引用なし

	パスワード

▼kiki さん　こんにちは

一番分かり安い方法で作ってみました。
Sub kiki()

For i = 1 To 500
　　For n = 1 To 500
　　　　If Cells(i, 1) = Worksheets("Sheet1").Cells(n, 4) Then
　　　　　　For m = 0 To 29
　　　　　　　　Cells(i, 3 + m) = Worksheets("Sheet1").Cells(n, 1 + m)
　　　　　　Next
　　　　　　Exit For
　　　　End If
　　Next
Next

End Sub


	【72396】Re:２つのシートのデータを照合し列が一...

kiki - 12/8/2(木) 22:12 -


	引用なし

	パスワード

▼UO3 さん：
>▼kiki さん：
>
>おはようございます。
>
>ht p://www.excel.studio-kazu.jp/kw/20120801223824.html
>
>あちらも、こちらも、マルチは【絶対禁止】というわけではないようですが、
>こちらの基本方針に、以下のようなことが掲載されています。
>ご参考まで。
>
>【以下、こちらの基本方針から引用】
>
>マルチポストについて
>別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。当質問箱では、マルチポストは原則認めています。つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。
>
>しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。
>
>また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

UO3 さん
ご指導ありがとうございます。
マルチ禁止ではないということはざっと見たのですが、宣言につきましては急いでおりまして見落としておりました・・。
言い訳ですね。申し訳ございませんでした。
以後気をつけて投稿したいと思います。


	【72397】Re:２つのシートのデータを照合し列が一...

kiki - 12/8/2(木) 22:17 -


	引用なし

	パスワード

▼ドカさん：
>▼kiki さん　こんにちは
>
>一番分かり安い方法で作ってみました。
>Sub kiki()
>
>For i = 1 To 500
>　　For n = 1 To 500
>　　　　If Cells(i, 1) = Worksheets("Sheet1").Cells(n, 4) Then
>　　　　　　For m = 0 To 29
>　　　　　　　　Cells(i, 3 + m) = Worksheets("Sheet1").Cells(n, 1 + m)
>　　　　　　Next
>　　　　　　Exit For
>　　　　End If
>　　Next
>Next
>
>End Sub

ドカさん
ご回答ありがとうございました！
コードの意味はわからない部分が多々ありますが・・。
早速明日VBAの教科書を片手に検証してみたいと思います。

どうやったらいいか全く思いつきませんでしたので、
教えていただいて本当に助かりました。
ありがとうございました。


	【72400】再:２つのシートのデータを照合し列が一...

kiki - 12/8/6(月) 22:07 -


	引用なし

	パスワード

▼kiki さん：
>▼ドカさん：
>>▼kiki さん　こんにちは
>>
>>一番分かり安い方法で作ってみました。
>>Sub kiki()
>>
>>For i = 1 To 500
>>　　For n = 1 To 500
>>　　　　If Cells(i, 1) = Worksheets("Sheet1").Cells(n, 4) Then
>>　　　　　　For m = 0 To 29
>>　　　　　　　　Cells(i, 3 + m) = Worksheets("Sheet1").Cells(n, 1 + m)
>>　　　　　　Next
>>　　　　　　Exit For
>>　　　　End If
>>　　Next
>>Next
>>
>>End Sub
>
>ドカさん
>ご回答ありがとうございました！
>コードの意味はわからない部分が多々ありますが・・。
>早速明日VBAの教科書を片手に検証してみたいと思います。
>
>どうやったらいいか全く思いつきませんでしたので、
>教えていただいて本当に助かりました。
>ありがとうございました。

ドカさん
追加で教えていただけると助かります。
先日は回答ありがとうございました。
実はあの後、こちらのコードを会社で作成してみました。
正確なセル番地、シートなどは多少変えましたが。

そうすると、一つ問題が発生してしまいました・・。

シートのデータを照合した際にシート1（データが記載されている)とシート2の列で照合して、一致したらシート2へ転記というものでしたが、シート1の列に同じキーワードの列があった場合、例えば二件あれば二件とも抽出転記したかったのですが、どうしても最初の一件しか転記されません。
異なる二件のキーワードをシート2に記載して検索した場合はちゃんと一件づつ、計二件転記されています。
これはなぜでしょうか？
回答いただいてから、自分なりにいろいろ検討しコードを変えてみたのですが結局わかりませんでした。

実は別サイトで回答いただいたコードもだめでした。

本日こんどはfindnextを使ってなんとか希望のものを書いてみたのですが、ちょっと怪しいかんじです。自分で作ったコードは会社にあるので今すぐにはお見せできません。

こちらのコードを手直しして使わせて頂ければ安心なのですが・・。
今後の勉強のためにも複数件あるデータを検索して転記する方法を教えて頂けますと幸いです。


	【72401】Re:再:２つのシートのデータを照合し列が...

UO3 - 12/8/7(火) 6:23 -


	引用なし

	パスワード

▼kiki さん：

おはようございます

>これはなぜでしょうか？

よこから失礼します。
こちらのコードもあちらのいくつかのコードも、シート2のキーにマッチするデータが
シート1に複数存在して、それらをすべて転記するという要件の説明がなかったため、
それに対応していないということですね。

ご自分でがんばって作られたコードをアップされれば、また、皆さんからアドバイスが
あると思います。


	【72402】Re:再:２つのシートのデータを照合し列が...

UO3 - 12/8/7(火) 6:36 -


	引用なし

	パスワード

▼kiki さん：

追伸です

以下の用件を明記されると皆さん考えやすいと思います。

・シート一（データ）で同じキーは連続しているのか、とびとびなのか。
・上記にもよりますが、２つのシートはキーの並びは同じかどうか
・シートにAAAというキーが複数あり得るか、ユニークか。
・もし、複数あれば、どのAAAに対しても、シート１の複数かもしれないAAAデータをすべて転記するのか？
・いずれにしても、シート２のAAAに対して、複数行を転記するということは
　シート２のAAAの次の行が下に繰り下がるわけですけど、シート２は、キー列以外は
　空白と考えていいですか？


	【72403】Re:再:２つのシートのデータを照合し列が...

UO3 - 12/8/7(火) 6:39 -


	引用なし

	パスワード

訂正です

>・シートにAAAというキーが複数あり得るか、ユニークか。

これは、正しくは

・シート２にAAAというキーが複数あり得るか、ユニークか。


	【72404】Re:再:２つのシートのデータを照合し列が...

ぶらっと - 12/8/7(火) 10:09 -


	引用なし

	パスワード

▼kiki さん：

なぁるほど。そういう要件だったんだ。
じゃぁ、そちらのコードの添削は、この板の回答者さんにおまかせして
あちらで回答したコードを踏まえて以下。データ量が多ければ効果ありかな？
参考まで。

Sub Sample()
　　Dim c As Range
　　Dim v() As Variant
　　Dim keyV() As String
　　Dim b() As Variant
　　Dim cols As Long
　　Dim j As Long
　　Dim dic As Object
　　Dim sh1 As Worksheet
　　Dim cnt As Long
　　Dim fIdx As Long
　　Dim mIdx As Long
　　Dim w As Variant
　　Dim n As Long
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　Set sh1 = Sheets("Sheet1")
　　fIdx = 1　　'転記用配列行カウンター
　　ReDim v(1 To Rows.Count)　　　　　　'転記用配列を最大行で準備
　　ReDim keyV(1 To Rows.Count, 1 To 1) 'キー列用配列
　　
　　With Sheets("Sheet1")
　　　　'シート１の列数取得
　　　　cols = .UsedRange.Cells(.UsedRange.Cells.Count).Column
　　　　ReDim b(1 To 1, 1 To cols) 'シート１にない場合の転記行スケルトン
　　End With
　　
　　With Sheets("Sheet2")
　　　　'シート２のA1からA列のデータ最終行までのセルを１つずつ取り出す
　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
　　　　　　'シート２のキーの重複は無視（処理しない）
　　　　　　If Not dic.exists(c.Value) Then
　　　　　　　　'シート１のD列に、その値があるかどうか
　　　　　　　　cnt = WorksheetFunction.CountIf(sh1.Columns("D"), c.Value)
　　　　　　　　dic(c.Value) = Array(fIdx, cnt, 0)
　　　　　　　　If cnt > 0 Then
　　　　　　　　　　fIdx = fIdx + cnt 'シート２にあれば
　　　　　　　　Else
　　　　　　　　　　v(fIdx) = b　　　　　　 'なければ行スケルトン
　　　　　　　　　　keyV(fIdx, 1) = c.Value 'キー列
　　　　　　　　　　mIdx = fIdx '配列セット行の最大数
　　　　　　　　　　fIdx = fIdx + 1
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　　　
　　End With

　　With Sheets("Sheet1")
　　　　'シート1のD1からD列のデータ最終行までのセルを１つずつ取り出す
　　　　For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
　　　　　　'もし辞書にあれば（シート２にあれば）１行分のイメージを配列に格納
　　　　　　If dic.exists(c.Value) Then
　　　　　　　　w = dic(c.Value)
　　　　　　　　n = w(0) + w(2)
　　　　　　　　v(n) = c.EntireRow.Resize(, cols).Value
　　　　　　　　'配列セット行の最大値
　　　　　　　　mIdx = WorksheetFunction.Max(n, mIdx)
　　　　　　　　w(2) = w(2) + 1
　　　　　　　　dic(c.Value) = w
　　　　　　　　If w(2) = 1 Then keyV(n, 1) = c.Value　 'キー列用配列
　　　　　　End If
　　　　Next
　　End With

　　With Sheets("Sheet2")
　　　　Cells.ClearContents　　　　 '最初に転記領域のクリア
　　　　.Range("A1").Resize(mIdx).Value = keyV　'キー列セット
　　　　ReDim Preserve v(1 To mIdx)　　　　　　 '転記用配列を実際の行数分に圧縮
　　　　.Range("C1").Resize(mIdx, cols).Value = _
　　　　　　WorksheetFunction.Transpose(WorksheetFunction.Transpose(v))
　　　　.Select
　　End With

　　MsgBox "転記終了"

End Sub


	【72405】Re:再:２つのシートのデータを照合し列が...

kanabun - 12/8/7(火) 14:25 -


	引用なし

	パスワード

▼kiki さん：おじゃまします。 >今後の勉強のためにも複数件あるデータを検索して転記する方法を [Sheet2]のA列にあるリストに重複はなかったですか？一般機能ですが、フィルタオプションで、その[Sheet2]A列を抽出条件(リスト)範囲とすると簡単なコードで、リストにあるデータだけ[Sheet2]に抽出できますよねそれをマクロにしたものが、以下です。 Sub Try1() 'Sheet1より抽出転記、並び替え　　Dim Rng1 As Range 　　Dim Rng2 As Range 　　Dim Rng3 As Range 　　　　With Worksheets("Sheet1") 　　　　'[Sheet1]1行目には A列から必要列まで(F1, F2,F3, F4,... F30のように) 　　　　'　　　列見出しが入っているものと仮定しています　　　　Set Rng1 = .Range("AD1", .Cells(.Rows.Count, 1).End(xlUp)) 　　End With 　　With Worksheets("Sheet2") 　　　　If Not .Cells(1).HasFormula Then 　　　　　　.Rows(1).Insert 　　　　　　.Cells(1).Formula = "=Sheet1!D1" 　　　　End If 　　　　Set Rng2 = .Range("A1", .Cells(1).End(xlDown)) '抽出リスト　　　　Set Rng3 = .Range("C1").Resize(, Rng1.Columns.Count) 　　End With 　　Rng3.EntireColumn.ClearContents 　　Rng3.Rows(1).Value = Rng1.Rows(1).Value '列見出しをコピーします　　　　　　　'A列にリストのあるデータ行だけ転記します（フィルタオプション）　　Rng1.AdvancedFilter xlFilterCopy, Rng2, Rng3 　　　　'転記後、第4列で並び替えます　　Rng3.CurrentRegion.Sort Key1:=Rng3.Columns(4), Order1:=xlAscending _ 　　　　, Header:=xlYes 　　 End Sub なお、[Sheet2]A列の抽出リストが単純な昇順リストとかになっていないときは並び替えのオプションをユーザー定義で「[Sheet2]A列の抽出リスト」を追加してこのSortOrderで並び替えてやる方法があります。（単純な昇順リストのほうが、あとで読みやすいと思われますが）


	【72407】Re:再:２つのシートのデータを照合し列が...

kiki - 12/8/7(火) 20:48 -


	引用なし

	パスワード

UO3 さん

お返事ありがとうございます。

私の最初の質問が悪く皆さまにお手数お掛けして申し訳ございません。
（当初は私も仕様をきちっと理解していませんでした）
下記にコード等記載致しました。

どなたか見て頂き添削頂けますと幸いです
。

長文失礼致します。
下記コードを掲載致しますので、大変お手数ですがコードの添削とやりたいことをするには今後どこをどう変更していったらよいかご指導をお願い致します。

過去の質問でｼｰﾄ1とｼｰﾄ2と名称を付けていましたが、わかりにくいため、マクロを設置し抽出キーを入力するものを「表」ｼｰﾄ、読み込むデータが入力されているものを「データ」ｼｰﾄと表現を変更させていただきます。また、多少仕様変更となりまして過去ご回答頂いた皆さまには申し訳ございませんが、こちらの
質問内容においてご指導頂けますと助かります。

前提条件
・表シートに記載のあるＣ列記載のキーとデーターシートのＡ列記載のキーで一致させ、一致した場合にデータシートの一部を表シートのセルＯ列からＡＨ列までに転記したい。
・表シートはＣ５セルから、Ｃ８０くらいまでに抽出キーとするキーを入力出来るフォーマットで、Ｃ列からＡＨ列まで横に伸びていますが、転記先の場所はＯからＡＨ列です。Ｄ～Ｎ列は他のデータを入力予定ですが、抽出した後のことです。。
・表シートはセルの結合がされており、Ｃ５とＣ６が結合され同じようにＡＨまで２行づつ結合されています。
・表シートＣ列に記載するキーは例えば、AAAというキーとすると1件しか入れる予定はありません。結果として2件抽出されることはありますが。基本的には表シートにはAAA、BBBというようにユニークな番号を入れる予定です。（とういか、事前にAAAが複数あるか把握できないため)
・データシートは毎回データ数が変更となりますが、千件くらいの予想です。データ内には日付や金額、ブランク、０といった数値も記載されています。
・データシートの一行全てを転記するわけではないですが、恐らくＡ列と最右端から５列を除いて全て転記とかそういうものです。転記データにもブランクは入りますが、右端は0か金額かどちらかが入っている。
・また、データシートＡ列には同じキーが複数ある。1件の場合もあるし、AAAというキーが２件、３件とあることもある。恐らく最大でも４、５件かと思われます。
・データシートＡ列に複数同じキーとなっている場合には私の方の前段階でソートし昇順で並び変えをしてまとまっています。

質問１．表ｼｰﾄにキーワードをなる番号をＣ列に入力し、データシートから転記したいのですが、表シートC5にAAA、C7にBBBと記載して検索した際にはAAAが2件出てくるとしますと、私の記載のコードではAAAが2件あれば、O5の行へ1件、O7の行へ1件と転記されます。(ｾﾙはC5とC6が結合、右も同様に2行づつ結合され、下へ続いています。)
するとC列のC7にはBBBが記載されているのに右のO7はAAAのデータでずれてしまいます。これを、なんとか複数件検索転記する場合にはC列のBBBを下に1行ずらしてC9に入り、隣にBBBのデータを転記できないでしょうか？もし不可能であれば、抽出した2件目以降はAH列の右に追加したいのです。3件目があればさらに右へ。

質問２．上記のずらす処理が出来た場合、C7が空欄になってしまいます。複数件を転記しずらした場合にはC7にもAAAを記載できるようにできないでしょうか？例えば、上の値と同じ値を入れる等・・・。

質問３．表は日々更新して蓄積する予定です。そのため、読み込むファイルも日々更新し、異なる可能性があります。例：前日読み込んだファイルにはAAAが入っていたが今日は入っていないなど。
既存に入力してある番号（項目転記済）のものは読み込んだデータファイルに同番号があり、追加や変更があれば追記しますが、ないかまたは更新されていなければ何もせずに既存データはそのままで新規のデータのみ追加で転記していきたいです。
このようにするにはどうしたらいいでしょうか？私のコードですとAAAがC5で既存で表にあるとして、今回C7にCCCのデータを追加した場合でも書き換えてはいけないAAAの情報O5のところへ転記してしまうのです・・・。自分でそういうコードにしてしまったわけですが。

結合セルもあったりして、これらを解決する方法が全くわからず、ここ数日ずっと悩んでいます。VBAを始めて1週間ほど。本やネットで勉強しかき集めたおかしなコードかと思われますが、見て頂けますと本当に助かります。宜しくお願い致します。

Sub マッチング()
　　Dim 検索範囲 As Range, 該当セル As Range
　　Dim 検索開始行 As Long, 転記先行 As Long
　　Dim r As Range
　　
　　転記先行 = Worksheets("表").Range("O5").Row　'「転記先行」は（表）ｼｰﾄのO5ｾﾙ以下を代入
　　Worksheets("表").Activate　'(表)ｼｰﾄ選択
　　
　　For Each r In Worksheets("表").Range("C5:C55") '(表)ｼｰﾄのｾﾙC5からC55までの列をｒに代入し下記処理実行
　　
　　Set 検索範囲 = Worksheets("ﾃﾞｰﾀ").Range("A2").CurrentRegion.Columns(1) '検索範囲には(ﾃﾞｰﾀ)ｼｰﾄのｾﾙA2を含めた表のA列を代入
　　
　　Set 該当セル = 検索範囲.Find(what:=r.Value, lookat:=xlWhole) '該当ｾﾙには検索範囲からrを完全一致で検索し見つかった値を代入
　　
　　If Not 該当セル Is Nothing Then '該当ｾﾙが見つかった場合は
　　検索開始行 = 該当セル.Row '検索開始行に該当セルの番号を代入
　　
　　Do
　　
　　Cells(転記先行, 15).Value = 該当セル.Offset(0, 1).valuee '転記先行の15列目のセルに該当セルの1列右のセルの値を代入
　　Cells(転記先行, 16).Value = 該当セル.Offset(0, 2).valuee '転記先行の16列目のセルに該当セルの2列右のセルの値を代入
　　Cells(転記先行, 17).Value = 該当セル.Offset(0, 3).valuee '転記先行の17列目のセルに該当セルの3列右のセルの値を代入
　　Cells(転記先行, 18).Value = 該当セル.Offset(0, 4).valuee '転記先行の18列目のセルに該当セルの4列右のセルの値を代入
　　Cells(転記先行, 19).Value = 該当セル.Offset(0, 5).valuee '転記先行の19列目のセルに該当セルの5列右のセルの値を代入
　以下続き
　　Cells(転記先行, 35).Value = 該当セル.Offset(0, 21).valuee '転記先行の35列目のセルに該当セルの21列右のセルの値を代入

　　転記先行 = 転記先行 + 2　'転記先行に2を加算する。表のｼｰﾄが結合しているため1だとつまってしまう
　　
　　Set 該当セル = 検索範囲.FindNext(after:=該当セル)　　 '検索範囲の検索を該当セルの次のセルから再開
　　
　　Loop While 該当セル.Row <> 検索開始行　　　 '最初に検索された該当セルの行が再検索されるまで処理
　　
　　End If
　　
　　Next r
　　
　　Set 検索範囲 = Nothing
　　Set 該当セル = Nothing
　　　　
End Sub


	【72409】Re:再:２つのシートのデータを照合し列が...

kiki - 12/8/7(火) 20:54 -


	引用なし

	パスワード

▼ぶらっとさん：
>▼kiki さん：
>
>なぁるほど。そういう要件だったんだ。
>じゃぁ、そちらのコードの添削は、この板の回答者さんにおまかせして
>あちらで回答したコードを踏まえて以下。データ量が多ければ効果ありかな？
>参考まで。
>
> Sub Sample()
>　　Dim c As Range
>　　Dim v() As Variant
>　　Dim keyV() As String
>　　Dim b() As Variant
>　　Dim cols As Long
>　　Dim j As Long
>　　Dim dic As Object
>　　Dim sh1 As Worksheet
>　　Dim cnt As Long
>　　Dim fIdx As Long
>　　Dim mIdx As Long
>　　Dim w As Variant
>　　Dim n As Long
>　　
>　　Set dic = CreateObject("Scripting.Dictionary")
>　　Set sh1 = Sheets("Sheet1")
>　　fIdx = 1　　'転記用配列行カウンター
>　　ReDim v(1 To Rows.Count)　　　　　　'転記用配列を最大行で準備
>　　ReDim keyV(1 To Rows.Count, 1 To 1) 'キー列用配列
>　　
>　　With Sheets("Sheet1")
>　　　　'シート１の列数取得
>　　　　cols = .UsedRange.Cells(.UsedRange.Cells.Count).Column
>　　　　ReDim b(1 To 1, 1 To cols) 'シート１にない場合の転記行スケルトン
>　　End With
>　　
>　　With Sheets("Sheet2")
>　　　　'シート２のA1からA列のデータ最終行までのセルを１つずつ取り出す
>　　　　For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
>　　　　　　'シート２のキーの重複は無視（処理しない）
>　　　　　　If Not dic.exists(c.Value) Then
>　　　　　　　　'シート１のD列に、その値があるかどうか
>　　　　　　　　cnt = WorksheetFunction.CountIf(sh1.Columns("D"), c.Value)
>　　　　　　　　dic(c.Value) = Array(fIdx, cnt, 0)
>　　　　　　　　If cnt > 0 Then
>　　　　　　　　　　fIdx = fIdx + cnt 'シート２にあれば
>　　　　　　　　Else
>　　　　　　　　　　v(fIdx) = b　　　　　　 'なければ行スケルトン
>　　　　　　　　　　keyV(fIdx, 1) = c.Value 'キー列
>　　　　　　　　　　mIdx = fIdx '配列セット行の最大数
>　　　　　　　　　　fIdx = fIdx + 1
>　　　　　　　　End If
>　　　　　　End If
>　　　　Next
>　　　　
>　　End With
>
>　　With Sheets("Sheet1")
>　　　　'シート1のD1からD列のデータ最終行までのセルを１つずつ取り出す
>　　　　For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
>　　　　　　'もし辞書にあれば（シート２にあれば）１行分のイメージを配列に格納
>　　　　　　If dic.exists(c.Value) Then
>　　　　　　　　w = dic(c.Value)
>　　　　　　　　n = w(0) + w(2)
>　　　　　　　　v(n) = c.EntireRow.Resize(, cols).Value
>　　　　　　　　'配列セット行の最大値
>　　　　　　　　mIdx = WorksheetFunction.Max(n, mIdx)
>　　　　　　　　w(2) = w(2) + 1
>　　　　　　　　dic(c.Value) = w
>　　　　　　　　If w(2) = 1 Then keyV(n, 1) = c.Value　 'キー列用配列
>　　　　　　End If
>　　　　Next
>　　End With
>
>　　With Sheets("Sheet2")
>　　　　Cells.ClearContents　　　　 '最初に転記領域のクリア
>　　　　.Range("A1").Resize(mIdx).Value = keyV　'キー列セット
>　　　　ReDim Preserve v(1 To mIdx)　　　　　　 '転記用配列を実際の行数分に圧縮
>　　　　.Range("C1").Resize(mIdx, cols).Value = _
>　　　　　　WorksheetFunction.Transpose(WorksheetFunction.Transpose(v))
>　　　　.Select
>　　End With
>
>
>　　MsgBox "転記終了"
>
>
> End Sub

ぶらっとさん

私の確認不足でお手間を取らせて申し訳ございませんでした。
また、お返事大変感謝しております。
すぐには理解できないコードですが、明日からにらめっこして勉強させていただきたいです。

こちらのコードでは、上記新規質問させて頂いたものには対応難しいですよね？


	【72410】再：２つのシートのデータを照合し列が一...

kiki - 12/8/7(火) 21:11 -


	引用なし

	パスワード

下記にも掲載しましたが、見づらくなってしまいましたのでこちらにも失礼致します。

長文失礼致します。
下記コードを掲載致しますので、大変お手数ですがコードの添削とやりたいことをするには今後どこをどう変更していったらよいかご指導をお願い致します。

過去の質問でｼｰﾄ1とｼｰﾄ2と名称を付けていましたが、わかりにくいため、マクロを設置し抽出キーを入力するものを「表」ｼｰﾄ、読み込むデータが入力されているものを「データ」ｼｰﾄと表現を変更させていただきます。また、多少仕様変更となりまして過去ご回答頂いた皆さまには申し訳ございませんが、こちらの
質問内容においてご指導頂けますと助かります。

前提条件
・表シートに記載のあるＣ列記載のキーとデーターシートのＡ列記載のキーで一致させ、一致した場合にデータシートの一部を表シートのセルＯ列からＡＨ列までに転記したい。
・表シートはＣ５セルから、Ｃ８０くらいまでに抽出キーとするキーを入力出来るフォーマットで、Ｃ列からＡＨ列まで横に伸びていますが、転記先の場所はＯからＡＨ列です。Ｄ～Ｎ列は他のデータを入力予定ですが、抽出した後のことです。。
・表シートはセルの結合がされており、Ｃ５とＣ６が結合され同じようにＡＨまで２行づつ結合されています。
・表シートＣ列に記載するキーは例えば、AAAというキーとすると1件しか入れる予定はありません。結果として2件抽出されることはありますが。基本的には表シートにはAAA、BBBというようにユニークな番号を入れる予定です。（とういか、事前にAAAが複数あるか把握できないため)
・データシートは毎回データ数が変更となりますが、千件くらいの予想です。データ内には日付や金額、ブランク、０といった数値も記載されています。
・データシートの一行全てを転記するわけではないですが、恐らくＡ列と最右端から５列を除いて全て転記とかそういうものです。転記データにもブランクは入りますが、右端は0か金額かどちらかが入っている。
・また、データシートＡ列には同じキーが複数ある。1件の場合もあるし、AAAというキーが２件、３件とあることもある。恐らく最大でも４、５件かと思われます。
・データシートＡ列に複数同じキーとなっている場合には私の方の前段階でソートし昇順で並び変えをしてまとまっています。

質問１．表ｼｰﾄにキーワードをなる番号をＣ列に入力し、データシートから転記したいのですが、表シートC5にAAA、C7にBBBと記載して検索した際にはAAAが2件出てくるとしますと、私の記載のコードではAAAが2件あれば、O5の行へ1件、O7の行へ1件と転記されます。(ｾﾙはC5とC6が結合、右も同様に2行づつ結合され、下へ続いています。)
するとC列のC7にはBBBが記載されているのに右のO7はAAAのデータでずれてしまいます。これを、なんとか複数件検索転記する場合にはC列のBBBを下に1行ずらしてC9に入り、隣にBBBのデータを転記できないでしょうか？もし不可能であれば、抽出した2件目以降はAH列の右に追加したいのです。3件目があればさらに右へ。

質問２．上記のずらす処理が出来た場合、C7が空欄になってしまいます。複数件を転記しずらした場合にはC7にもAAAを記載できるようにできないでしょうか？例えば、上の値と同じ値を入れる等・・・。

質問３．表は日々更新して蓄積する予定です。そのため、読み込むファイルも日々更新し、異なる可能性があります。例：前日読み込んだファイルにはAAAが入っていたが今日は入っていないなど。
既存に入力してある番号（項目転記済）のものは読み込んだデータファイルに同番号があり、追加や変更があれば追記しますが、ないかまたは更新されていなければ何もせずに既存データはそのままで新規のデータのみ追加で転記していきたいです。
このようにするにはどうしたらいいでしょうか？私のコードですとAAAがC5で既存で表にあるとして、今回C7にCCCのデータを追加した場合でも書き換えてはいけないAAAの情報O5のところへ転記してしまうのです・・・。自分でそういうコードにしてしまったわけですが。

結合セルもあったりして、これらを解決する方法が全くわからず、ここ数日ずっと悩んでいます。VBAを始めて1週間ほど。本やネットで勉強しかき集めたおかしなコードかと思われますが、見て頂けますと本当に助かります。宜しくお願い致します。

Sub マッチング()
　　Dim 検索範囲 As Range, 該当セル As Range
　　Dim 検索開始行 As Long, 転記先行 As Long
　　Dim r As Range
　　
　　転記先行 = Worksheets("表").Range("O5").Row　'「転記先行」は（表）ｼｰﾄのO5ｾﾙ以下を代入
　　Worksheets("表").Activate　'(表)ｼｰﾄ選択
　　
　　For Each r In Worksheets("表").Range("C5:C55") '(表)ｼｰﾄのｾﾙC5からC55までの列をｒに代入し下記処理実行
　　
　　Set 検索範囲 = Worksheets("ﾃﾞｰﾀ").Range("A2").CurrentRegion.Columns(1) '検索範囲には(ﾃﾞｰﾀ)ｼｰﾄのｾﾙA2を含めた表のA列を代入
　　
　　Set 該当セル = 検索範囲.Find(what:=r.Value, lookat:=xlWhole) '該当ｾﾙには検索範囲からrを完全一致で検索し見つかった値を代入
　　
　　If Not 該当セル Is Nothing Then '該当ｾﾙが見つかった場合は
　　検索開始行 = 該当セル.Row '検索開始行に該当セルの番号を代入
　　
　　Do
　　
　　Cells(転記先行, 15).Value = 該当セル.Offset(0, 1).valuee '転記先行の15列目のセルに該当セルの1列右のセルの値を代入
　　Cells(転記先行, 16).Value = 該当セル.Offset(0, 2).valuee '転記先行の16列目のセルに該当セルの2列右のセルの値を代入
　　Cells(転記先行, 17).Value = 該当セル.Offset(0, 3).valuee '転記先行の17列目のセルに該当セルの3列右のセルの値を代入
　　Cells(転記先行, 18).Value = 該当セル.Offset(0, 4).valuee '転記先行の18列目のセルに該当セルの4列右のセルの値を代入
　　Cells(転記先行, 19).Value = 該当セル.Offset(0, 5).valuee '転記先行の19列目のセルに該当セルの5列右のセルの値を代入
　以下続き
　　Cells(転記先行, 35).Value = 該当セル.Offset(0, 21).valuee '転記先行の35列目のセルに該当セルの21列右のセルの値を代入

　　転記先行 = 転記先行 + 2　'転記先行に2を加算する。表のｼｰﾄが結合しているため1だとつまってしまう
　　
　　Set 該当セル = 検索範囲.FindNext(after:=該当セル)　　 '検索範囲の検索を該当セルの次のセルから再開
　　
　　Loop While 該当セル.Row <> 検索開始行　　　 '最初に検索された該当セルの行が再検索されるまで処理
　　
　　End If
　　
　　Next r
　　
　　Set 検索範囲 = Nothing
　　Set 該当セル = Nothing
　　　　
End Sub


	【72411】Re:再:２つのシートのデータを照合し列が...

kiki - 12/8/7(火) 22:25 -


	引用なし

	パスワード

▼kanabun さん：
>▼kiki さん：
>おじゃまします。
>
>>今後の勉強のためにも複数件あるデータを検索して転記する方法を
>
>[Sheet2]のA列にあるリストに重複はなかったですか？
>
>一般機能ですが、
>フィルタオプションで、その[Sheet2]A列を抽出条件(リスト)範囲とすると
>簡単なコードで、リストにあるデータだけ[Sheet2]に抽出できますよね
>
>それをマクロにしたものが、以下です。
>
>
>Sub Try1() 'Sheet1より抽出転記、並び替え
>　　Dim Rng1 As Range
>　　Dim Rng2 As Range
>　　Dim Rng3 As Range
>　　
>　　With Worksheets("Sheet1")
>　　　　'[Sheet1]1行目には A列から必要列まで(F1, F2,F3, F4,... F30のように)
>　　　　'　　　列見出しが入っているものと仮定しています
>　　　　Set Rng1 = .Range("AD1", .Cells(.Rows.Count, 1).End(xlUp))
>　　End With
>　　With Worksheets("Sheet2")
>　　　　If Not .Cells(1).HasFormula Then
>　　　　　　.Rows(1).Insert
>　　　　　　.Cells(1).Formula = "=Sheet1!D1"
>　　　　End If
>　　　　Set Rng2 = .Range("A1", .Cells(1).End(xlDown)) '抽出リスト
>　　　　Set Rng3 = .Range("C1").Resize(, Rng1.Columns.Count)
>　　End With
>　　Rng3.EntireColumn.ClearContents
>　　Rng3.Rows(1).Value = Rng1.Rows(1).Value '列見出しをコピーします
>　　　　　
>　　'A列にリストのあるデータ行だけ転記します（フィルタオプション）
>　　Rng1.AdvancedFilter xlFilterCopy, Rng2, Rng3
>　　
>　　'転記後、第4列で並び替えます
>　　Rng3.CurrentRegion.Sort Key1:=Rng3.Columns(4), Order1:=xlAscending _
>　　　　, Header:=xlYes
>　　
>End Sub
>
>
>なお、[Sheet2]A列の抽出リストが単純な昇順リストとかになっていないときは
>並び替えのオプションをユーザー定義で「[Sheet2]A列の抽出リスト」を追加し
>てこのSortOrderで並び替えてやる方法があります。（単純な昇順リストのほう
>が、あとで読みやすいと思われますが）

kanabun さん

お返事ありがとうございました。
大変勉強になります。
そういう方法でも良いのですね。

ちなみに、上記で再度質問させていただいたことには対応可能でしょうか＞＜
長文、仕様追加で申し訳ございません。


	【72412】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 12:51 -


	引用なし

	パスワード

▼kiki さん： >過去の質問でｼｰﾄ1とｼｰﾄ2と名称を付けていましたが、わかりにくいため、マクロを >設置し抽出キーを入力するものを「表」シート、読み込むデータが入力されている >ものを「データ」シートと表現を変更させていただきます。 > >前提条件 >・「表」シートに記載のあるＣ列記載のキーとデーターシートのＡ列記載のキーで >　一致させ、一致した場合にデータシートの一部を「表」シートのセルＯ列から >　ＡＨ列までに転記したい。あれ？一番最初のシートレイアウトによれば、「データ」シート　　A　　　B　　　C　　D　　E　　F　　G　　　　　　aaa　 1/1　あああ　a-1　0　　 0　　0 　　bbb　 2/3　いいい　b-2　3000　0　　0 　　ccc　 7/2　ううう　c-3　900　 0　　0 　　ddd　 6/4　えええ　d-4　100　 200　300 「表」シート　　A列　 B列 C列　・・・・・・　　a-1 　　b-2 　　c-3 　　d-4 のようで、表シートの「A列」アイテムをデータシート（元表）の「D列」と LOOKUP とるんじゃなかったですか？具体的には "a-1", "b-2", "c-3", "d-4" のような文字列を比較するものと思ってましたが、いつから > AAA、BBBというようにユニークな番号に変わったんですか？ > 結合セルもあったりして結合セルはVBAと相性がよくありません。そのシート構成は、はじめてのマクロを組む人用にはできていないと思います。 Sheet構成を簡単にして一般機能でできるVLOOKUP式とかフィルタオプションをマクロ化することを考えるか？シート構成が変更不可なのなら、今回は、どこか外部に注文されるか、どちらかでしょうね


	【72413】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 13:34 -


	引用なし

	パスワード

とはいえ、お書きになったコードは大変読みやすく、とても1週間やそこらのひとが書いたものとは思えません。 21列分転記するところをサブプロシージャに独立させると、こういうことをしようとされてるんですよね？ Sub マッチング() 　　Dim 検索範囲 As Range, 該当セル As Range 　　Dim FirstHitRow As Long 　　Dim 転記先行 As Long '最初にヒットした行番号　　Dim r As Range 　　With Worksheets("ﾃﾞｰﾀ") '「検索範囲」は A列　　　　Set 検索範囲 = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) 　　End With 　　　　転記先行 = 5　'「転記先行」はO列 5行目から　　For Each r In Worksheets("表").Range("C5:C55") 'C列　　　　　Set 該当セル = 検索範囲.Find(what:=r.Value, lookat:=xlWhole) 　　　　If Not 該当セル Is Nothing Then '該当ｾﾙが見つかった場合は　　　　　　FirstHitRow = 該当セル.Row '最初にヒットした行番号　　　　　　Do 　　　　　　　　CopyLine 該当セル, Cells(転記先行, 15) '21列をコピー　　　　　　　　　　　　　　　　転記先行 = 転記先行 + 2　'転記先行に2を加算する。　　　　　　　　　　　　Set 該当セル = 検索範囲.FindNext(該当セル) '次を検索　　　　　　　　　　Loop While 該当セル.Row <> FirstHitRow 　　　　End If 　　　Next r End Sub Private Sub CopyLine(該当セル As Range, 転記先 As Range) 　　該当セル.Offset(, 1).Resize(, 21).Copy 転記先　　 End Sub ＃外注したら？と助言しましたが、結合セルがあるために発生する　個々の問題点を再度質問されたら、親切な方が修正モジュールを　書いてくださるかもしれませんよ(^^


	【72414】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 14:34 -


	引用なし

	パスワード

質問３．はおいておいて、質問１．と質問２．に関してだけですが、（簡単のため、結合セルはなくて、1行1データの構成であったと仮定しますと）要は「データ」シート　　A　　　B　　　C　　D　　E　　F　　G　　　　　　aaa　 1/1　あああ　a-1　0　　 0　　0 　　aaa　 2/1　あああ　a-2　0　　 0　　0 　　bbb　 2/3　いいい　b-1　1000　0　　0 　　bbb　 5/3　いいい　b-2　3000　0　　0 　　ccc　 5/2　ううう　c-1　900　 0　　0 　　ccc　 8/2　ううう　c-2　1200　 0　　0 　　ddd　 6/4　えええ　d-4　100　 200　300 「表」シート　　A列　 B列　C列　…　O列　 P列　　Q列　　R列　　　　　　　 aaa 　　　　　　　 bbb 　　　　　　　 ccc 　　　　　　　 eee とあったら、 Find転記後「表」シートは ↓のようになっていればいいってことなんですよね？「表」シート　A列　 B列　C列　…　O列　 P列　 Q列　R列　 S列　T列 … 　　　　　　 aaa　　　 1/1　あああ　a-1　0　　 0　　0 　　　　　　 aaa　　　 2/1　あああ　a-2　0　　 0　　0 　　　　　　 bbb　　　 2/3　いいい　b-1　1000　0　　0 　　　　　　 bbb　　　 5/3　いいい　b-2　3000　0　　0 　　　　　　 ccc　　　 5/2　ううう　c-1　900　 0　　0 　　　　　　 ccc　　　 8/2　ううう　c-2　1200　0　　0 だったら「表」シートのC列の（元のユニークな）抽出データは配列に覚えておいて、「データ」シートの該当行を<転記先行>の O列～AH列に転記するとき、同時に検索値もC列に<転記先行>に上書きしてしまえば、いいのでは？ Sub マッチング2() 　　Dim 検索範囲 As Range, 該当セル As Range 　　Dim FirstHitRow As Long 　　Dim 転記先行 As Long '最初にヒットした行番号　　Dim tbl As Variant, v As Variant 　　　　With Worksheets("データ") '「検索範囲」は A列　　　　Set 検索範囲 = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) 　　End With 　　　　転記先行 = 5　'「転記先行」はO列 5行目から　　With Worksheets("表").Range("C5:C55") 　　　　tbl = .Value 'C列抽出データ　　　　.ClearContents 　　End With 　　For Each v In tbl 　　　　If Not IsEmpty(v) Then 　　　　　Set 該当セル = 検索範囲.Find(v, , xlFormulas, xlWhole) 　　　　　If Not 該当セル Is Nothing Then '該当ｾﾙが見つかった場合は　　　　　　　FirstHitRow = 該当セル.Row　'最初にヒットした行番号　　　　　　　Do 　　　　　　　　　該当セル.Copy Cells(転記先行, 3) 'C列に上書き　　　　　　　　　CopyLine 該当セル, Cells(転記先行, 15) '21列をコピー　　　　　　　　　　　　　　　　　　転記先行 = 転記先行 + 2　'転記先行に2を加算する。　　　　　　　　　　　　　　Set 該当セル = 検索範囲.FindNext(該当セル) '次を検索　　　　　　　　　　　　Loop While 該当セル.Row <> FirstHitRow 　　　　　End If 　　　　End If 　　　Next End Sub


	【72415】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 14:46 -


	引用なし

	パスワード

「表」シート　A列　 B列　C列　…　O列　 P列　　Q列　　R列　　　　　　 aaa 　　　　　　 bbb 　　　　　　 ccc 　　　　　　 eee が、転記後「表」シート　A列　 B列　C列　　　　　　　 aaa　　　　　　　 aaa　　　　　　　 bbb　　　　　　　 bbb　　　　　　　 ccc　　　　　　　 ccc　のようになって元のリストが失われてまずい、ってことなら、元の抽出リストはどこか別の範囲に 2行おきでなく、1行づつ連続リストにしておけば済むのに？で、その抽出リストは入力規則で重複データを追加できないようにしておく、とかすれば、使いやすいシートになると思います。


	【72416】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 17:07 -


	引用なし

	パスワード

シートを追加してそこのA列に「抽出リスト」を書いておくというばあいは、こんな風になりますシートは >　　Set WS1 = Worksheets("Sheet1") >　　Set WS2 = Worksheets("抽出") >　　Set WS3 = Worksheets("抽出リスト") と変数にしていますので、シート名を環境に合わせてください。（結合セルでは Copyで転記できないので、　先範囲.Value = 元範囲Value 　としています） Sub マッチング2() 　　Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet 　　　　Dim 検索範囲 As Range, 該当セル As Range 　　Dim FirstHitRow As Long 　　Dim 転記先行 As Long '最初にヒットした行番号　　Dim tbl As Variant, v As Variant 　　　　Set WS1 = Worksheets("Sheet1") 　　Set WS2 = Worksheets("抽出") 　　Set WS3 = Worksheets("抽出リスト") 　　　　With WS1 '「検索範囲」は A列　　　　Set 検索範囲 = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) 　　End With 　　　　転記先行 = 5　'「転記先行」はO列 5行目から　　With WS3 　　　　tbl = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).Value 'A列抽出データ　　End With 　　　　For Each v In tbl 　　　　Set 該当セル = 検索範囲.Find(v, , xlFormulas, xlWhole) 　　　　If Not 該当セル Is Nothing Then '該当ｾﾙが見つかった場合は　　　　　　FirstHitRow = 該当セル.Row　'最初にヒットした行番号　　　　　　Do 　　　　　　　　WS2.Cells(転記先行, 3) = 該当セル() 'C列に上書き　　　　　　　　CopyLine 該当セル, WS2.Cells(転記先行, 15) '21列をコピー　　　　　　　　　　　　　　　　転記先行 = 転記先行 + 2　'転記先行に2を加算する。　　　　　　　　　　　　Set 該当セル = 検索範囲.FindNext(該当セル) '次を検索　　　　　　　　　　Loop While 該当セル.Row <> FirstHitRow 　　　　End If 　　Next End Sub Private Sub CopyLine(該当セル As Range, 転記先 As Range) '◆変更　　転記先.Resize(, 21).Value = 該当セル.Offset(, 1).Resize(, 21)() End Sub


	【72418】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 17:17 -


	引用なし

	パスワード

直前で追加した「抽出リスト」シートですが、この[A2:A1000]範囲を選択してメニュ－[ツール]-[入力規則...]で、　　入力値の種類：ユーザー設定　　数式　： Countif($A$2:A2)<2 としておくと、重複したアイテムを入力できなくなります。参考まで。


	【72419】Re:再：２つのシートのデータを照合し列...

kiki - 12/8/8(水) 20:41 -


	引用なし

	パスワード

kanabun さん

大変お世話になっております。
私の拙い説明、コードを見てお返事頂けまして大変感謝致します。

まず、外注したらとのご指摘でございますが、上司はそのような気はさらさらなく諸事情によりこの仕事をなんとか自分で完成させなければなりません。
また、

>"a-1", "b-2", "c-3", "d-4" のような文字列を比較するもの
>と思ってましたが、
>いつから
> AAA、BBBというようにユニークな番号
に変わったんですか？

こちらのご指摘ですが、申し訳ございません。
知識不足により、例の違いで問題が発生すると考えもつかずにとりあえずの番号で質問してしまっておりました。
正確には、A13-54ASDHのようなアルファベット、数字、ハイフンが混在した番号です。
でもそうですよね、変数使用の際にも文字や数字など区別して使用するのですから当然でしたね。申し訳ございませんでした。

そして私の意図を正確にくみ取って頂きありがとうございました。

Ｏ列への転記の記述など、このようにすっきり書きたかったのです！
どうしてよいかわからず、長々とコードを書いてしまいました。
また、転記の際にキーコードをＣ列に転記とは、ずらすことばかり考えておりまして、全く思いつきませんでした！
そのようにしてみます。
本当にありがとうございます。また、もっと柔軟に考えられるようになりたいです。

ところで、記載頂いたコードを明日の出社まで待ち切れず自宅のＰＣで仮のデータと表を作って動かしてみたのですが、エラーが出てしまいました。
質問(1)
最初に回答頂きました【72413】のコードで、
>>With Worksheets("ﾃﾞｰﾀ") '「検索範囲」は A列
の部分で「インデックス範囲が有効にありません」と出てしまいました。なぜでしょうか？家のexcel環境によって違いますかね。

質問(2)
次に回答頂きました【72413】のコードで
>>CopyLine 該当セル, Cells(転記先行, 15) '21列をコピー
の「CopyLine」で「subまたはfunctionが定義されていません」と出てしまいました。これもまた何故かわからずです。

なぜでしょうか？
ちなみに、【72416】のコードはまだ試せていません。

質問(3)
私の作成・提示させて頂きました拙いコードですと、本日検証していたところ表シートの
「表」シート
　A列　 B列　C列　
　　　　　　 aaa　

　　　　　　 aaa　

　　　　　　 bbb　

　　　　　　 bbb　

　　　　　　 ccc　

　　　　　　 ccc　

この状態(aaa、bbb、cccがデータシート、表にも2件づつ記載)で追記で例えばdddというコードを追加でC列にいれて検索したところ、O列にはaaaが2×2、bbbが2×2、cccが2×2とそれぞれ4件O列以下に並び最後にdddのデータが記載され、データが重複してしまっていました。
当然ですよね・・・。
C列にもキーの番号を入れるとこうなることに初めて気付きました。
それで、C列の重複している番号は１件と認識するか他の方法はないか調べなければと焦っていたのですが・・。
ご提示頂いたコードではいかがでしょうか？
私も最初に気づけばよかったのですが、全く思い至りませんでした＞＜
コードを試して実験しようとしたのですがエラーでしたので、調べられませんでした。また、読解力も遅く、会社の本で調べるとまた時間が経ってしまうので質問させて下さい。

何度も大変恐縮ですが教えて頂けますと助かります。


	【72420】Re:再:２つのシートのデータを照合し列が...

UO3 - 12/8/8(水) 21:02 -


	引用なし

	パスワード

▼kiki さん：

こんばんは
意見だけ申し上げて、対応コード案をださず、恐縮です。
まぁ、そのあたりは、kanabunさんにおまかせして。

●やはり仕様はきちんと説明しましょう。以下のような表現ですとコード案もなかなか
　考えづらくなります。

>・表シートはＣ５セルから、Ｃ８０くらいまでに抽出キーとするキーを入力出来るフォーマットで、

　「くらい」という表現が、あいまいですね。どこから、どこと明記しましょう。

>・データシートの一行全てを転記するわけではないですが、恐らくＡ列と最右端から５列を除いて全て転記とか

　「おそらく」ではなく、転記の条件はこうだと明記しましょう。

●２行の結合。目的は何でしょう？
　もちろん、これをコードで対応することはできます。できますが、なぜ２行が結合されているのか？
　見た目の行の高さですか？　それなら、行の高さそのものを倍にしておけば、普通の１行になりますね。
　そうしておくと、コードが、きわめて素直な普通のコードにできます。
　結合セルだと、コード処理も煩雑になります。

●それと、この掲示板でレスをする際、いったん、レス対象のスレがすべて引用されますね。
　それを、そのままにしてコメントしてアップしますと、非常に見にくくなります。
　回答に必要な部分以外の引用は消しましょう。


	【72421】Re:再：２つのシートのデータを照合し列...

kiki - 12/8/8(水) 21:06 -


	引用なし

	パスワード

kanabun さん

質問(3)で記載した件ですが、この抽出リストを重複できないような設定にしておけば重複データが入らないのですかね？
それでしたらそれがベストなように思います。
まだ、コードは試せていませんが＞＜

私の浅知恵で思いついたのは、重複したデータが出たら、kanabun さんがおっしゃるような抽出リストを作りそれをフィルタオプションで重複なしにしてまたコピーして別シートにしてそれを転記するというコードを追加で記載するとかそのくらいです。

kanabunさんのコードで出来たらほんとに助かります。


	【72422】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/8(水) 21:10 -


	引用なし

	パスワード

▼kiki さん：こんにちは～～ >ところで、記載頂いたコードを明日の出社まで待ち切れず自宅のＰＣで仮のデータと表を作って動かしてみたのですが、エラーが出てしまいました。 >質問(1) >最初に回答頂きました【72413】のコードで、 > >>With Worksheets("ﾃﾞｰﾀ") '「検索範囲」は A列 >の部分で「インデックス範囲が有効にありません」と出てしまいました。なぜでしょうか？ → 「ﾃﾞｰﾀ」という名前のシートがないのでは？ >質問(2) >次に回答頂きました【72413】のコードで > >>CopyLine 該当セル, Cells(転記先行, 15) '21列をコピー >の「CopyLine」で「subまたはfunctionが定義されていません」と出てしまいました。これもまた何故かわからずです。 > >なぜでしょうか？文字通り、 '-------------------------------------------- Private Sub CopyLine(該当セル As Range, 転記先 As Range) 　　該当セル.Offset(, 1).Resize(, 21).Copy 転記先　　 End Sub '-------------------------------------------- がモジュールに書いてないからでは？ >ちなみに、【72416】のコードはまだ試せていません。上の > Private Sub CopyLine(該当セル As Range, 転記先 As Range) の中味が【72413】と【72416】とで違ってます。【72413】のほうは結合セルがあるとコピー元と貼り付け先のかっこうがちがうので貼り付けできません。と怒られると思います。結合セルがあるときは、　転記先範囲.Value = 転記元範囲.Value のようにしてください。 >【72416】 Private Sub CopyLine(該当セル As Range, 転記先 As Range) '◆変更　　転記先.Resize(, 21).Value = 該当セル.Offset(, 1).Resize(, 21)() End Sub > >質問(3) >私の作成・提示させて頂きました拙いコードですと、本日検証していたところ表シートの >「表」シート >　A列　 B列　C列　 >　　　　　　 aaa　 > >　　　　　　 aaa　 > >　　　　　　 bbb　 > >　　　　　　 bbb　 > >　　　　　　 ccc　 > >　　　　　　 ccc　 > >この状態(aaa、bbb、cccがデータシート、表にも2件づつ記載)で追記で例えばdddというコードを追加でC列にいれて検索したところ、O列にはaaaが2×2、bbbが2×2、cccが2×2とそれぞれ4件O列以下に並び最後にdddのデータが記載され、データが重複してしまっていました。 >当然ですよね・・・。 >C列にもキーの番号を入れるとこうなることに初めて気付きました。 >それで、C列の重複している番号は１件と認識するか他の方法はないか調べなければと焦っていたのですが・・。 >ご提示頂いたコードではいかがでしょうか？う～ん、最後のこちらからの提案は読んでもらえましたか？抽出リストは別の専用シートに置くという案です。【72415】 > 元の抽出リストはどこか別の範囲に 2行おきでなく、1行づつ > 連続リストにしておけば済むのに？ > で、その抽出リストは入力規則で重複データを追加できないように > しておく、とかすれば、使いやすいシートになると思います。【72418】 > 「抽出リスト」シートですが、 > この[A2:A1000]範囲を選択して > メニュ－[ツール]-[入力規則...]で、 > 　　入力値の種類：ユーザー設定 > 　　数式　： Countif($A$2:A2)<2 > としておくと、 > 重複したアイテムを入力できなくなります。 > > 参考まで。


	【72426】Re:再：２つのシートのデータを照合し列...

kiki - 12/8/8(水) 22:13 -


	引用なし

	パスワード

kanabun さん：

こんばんは！
お返事ありがとうございます。
ご返答頂いた件ですが、一部先走って質問してしまい申し訳ございませんでした。
気ばかり焦ってしまい、コードの解読もままならないまま質問してしまいました。

　 >→ 「ﾃﾞｰﾀ」という名前のシートがないのでは？
作成したはずだったのですが、全角、半角など些細な違いがあったのかもしれません。後日試します。

>'--------------------------------------------
>Private Sub CopyLine(該当セル As Range, 転記先 As Range)
>　　該当セル.Offset(, 1).Resize(, 21).Copy 転記先
>　　
>End Sub
>'--------------------------------------------
>がモジュールに書いてないからでは？

「Private Sub」というものを初めて知りました。
そういうものがあるのですね。
確かに他のコードには記載ありました。
初心者本には記載ないのか、私が見落としているのか。
また勉強になります。調べてみます。

>う～ん、
>最後のこちらからの提案は読んでもらえましたか？
>
>抽出リストは別の専用シートに置くという案です。

大変失礼なことをして申し訳ございませんでした。
kanabun さんはきちんとこれらの処理による問題点を見抜いてご提案して頂いてたのですね。
気ばかり焦って質問してしまい、ご気分を害されたのでしたなら申し訳ございませんでした。
頂いた回答を理解して質問するよう気をつけます。

抽出リストを用意するというご提案ありがとうございます！
やはり表形式でないリストはあったほうが運用面でも安心ですよね。
他に流用するかもしれませんし。

いただいたコードをプリントアウトしましたので、就寝までにらめっこして解読理解し明日またチャレンジしてみたいと思います。

何度もありがとうございました。


	【72427】Re:再:２つのシートのデータを照合し列が...

kiki - 12/8/8(水) 22:21 -


	引用なし

	パスワード

UO3 さん：
こんばんは。
至らない部分へのご指摘ありがとうございます。

>●やはり仕様はきちんと説明しましょう。以下のような表現ですとコード案もなかなか
>　考えづらくなります。
>
>　「くらい」という表現が、あいまいですね。どこから、どこと明記しましょ　う。
>　「おそらく」ではなく、転記の条件はこうだと明記しましょう。
　
→大変申し訳ありませんでした。
　質問や添削をお願いしておいて仕様があいまいとは申し訳ありませんでした。
　以後気をつけます。

>●２行の結合。目的は何でしょう？
>　もちろん、これをコードで対応することはできます。できますが、なぜ２行が結合されているのか？
>　結合セルだと、コード処理も煩雑になります。

→そうですよね・・・。
　結合セルには悩まされます。
　実はこの表で私が関われる部分は一部で、他に空欄にしてある部分は他部署が関　わります。そこの部分に上段、下段と二段にわけて記載している部分がありまし　てそのあたりが関わり結合されています。
　私の権限では表の形態を変えられないのです・・。

>●それと、この掲示板でレスをする際、いったん、レス対象のスレがすべて引用されますね。
>　それを、そのままにしてコメントしてアップしますと、非常に見にくくなります。
>　回答に必要な部分以外の引用は消しましょう。

→大変失礼致しました。
　以後気をつけます。

　今後ともどうぞ宜しくお願い致します！


	【72430】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/9(木) 14:26 -


	引用なし

	パスワード

▼kiki さん： > >抽出リストは別の専用シートに置くという案とやはり最初に提案した【フィルタオプション】案で再度書いてみました。前のフィルタオプションは抽出したものを別の範囲に一気に書き出すオプションでしたが、抽出先が結合セルであるため、こんどは抽出元シート上で抽出して、抽出行を一行づつ転記するというものです。 Sub マッチング3() 　　Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet 　　Dim Rng1 As Range 　　Dim Rng2 As Range 　　Dim Rng3 As Range 　　Dim c As Range, c1 As Range, c2 As Range 　　　　Set WS1 = Worksheets("Sheet1") 　　Set WS2 = Worksheets("抽出") 　　Set WS3 = Worksheets("抽出リスト") 　　　　With WS1 '抽出元表検索範囲は A列 [A1]は列見出し　　　　Set Rng1 = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 　　End With 　　With WS2 '転記先セル（2か所）　　　　Set c1 = .Range("C5") 　　　　Set c2 = .Range("O5") 　　End With 　　With WS3 '抽出リスト範囲　　　　Set Rng3 = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 　　　　Rng3.Item(1).Formula = "=" & Rng1.Item(1).Address(External:=True) 　　End With 　　　　'フィルタオプション実行 (抽出リスト範囲 Rng3) 　　Rng1.AdvancedFilter xlFilterInPlace, Rng3 　　　　'Rng1の可視セルだけ転記処理　　For Each c In Intersect(Rng1, Rng1.Offset(1)) _ 　　　　　　　　　　　　　　　　.SpecialCells(xlVisible) 　　　　c1.Value = c.Value 　　　　c2.Resize(, 21).Value = c.Offset(, 1).Resize(, 21).Value 　　　　　　Set c1 = c1.Offset(1)　'次の転記先セル　　　　Set c2 = c2.Offset(1) 　　Next 　　Rng1.Worksheet.ShowAllData End Sub >　　　　Set c1 = c1.Offset(1)　'次の転記先セルのところは、現在のセルから [↓]キーを一回押した操作に相当します。たとえば、「抽出リスト」シートの[A1]にカーソルをおいて [↓]を一度押してください。どこに移動しましたか？ [A2]セルですよね。今度は「抽出」シートの[C5:C6]結合セルにカーソルをおいて[↓]キーを一回押してみてください。どこへ移動しましたか？ [C5:C6]は結合セルだから [↓]により [C7]セル（正確には [C7:C8] セル）に移動します。これが >　　 Set c1 = c1.Offset(1) の意味です。


	【72431】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/9(木) 14:42 -


	引用なし

	パスワード

ごめんなさい。「入力規則」の数式がまちがってました。 >直前で追加した「抽出リスト」シート >ですが、 >この[A2:A1000]範囲を選択して >メニュ－[ツール]-[入力規則...]で、 >　　入力値の種類：ユーザー設定 >　　数式　： Countif($A$2:A2)<2　　 ←誤　　数式　： =Countif($A$2:A2,A2)=1　　 ← 正 >としておくと、 >重複したアイテムを入力できなくなります。でした m(_ _)m


	【72437】Re:再：２つのシートのデータを照合し列...

kiki - 12/8/9(木) 23:21 -


	引用なし

	パスワード

kanabun さん：
こんばんは。

>> >抽出リストは別の専用シートに置くという案
>と
>やはり最初に提案した【フィルタオプション】案で
>再度書いてみました。

何度もご丁寧に案を出して頂いてありがとうございます。
本日、教えていただいたコードを数パターン試してみました。

実は、抽出リストを使わない案が上手く動かなかったのですが、
（どこが、とういのは控えるのを忘れてしまったのですが）プリントしたコードを入力しているため私の記載に誤りがあったのかもしれませんのでまたもう一度やってみます。

抽出リスト案のものはしっかりと動きました！
ありがとうございます。
確かに、抽出リストに入力規制を入れ、試しに同番号を入れた際に？？
という感じでしたが、本日教えていただいたものに変えればいいんですね。
入力規制を使うのも初めてでしたので、何か私がミスっているのかと思いました。

また、フィルタオプションも教えて頂いて恥ずかしながら初めて使いました。
便利なんですね～。他業務にも活かせそうです。

今回教えていただいたコードも明日試してみたいと思います。
そして丁寧な説明をありがとうございます。

どのコードで作成していくのが一番業務によいかまた考えたいと思います。
個人的には、抽出リストに入力が一番いいのですが・・・。
シートを他部署共同で運用するため許可が降りるか・・。

kanabunさんのようにコードの組み立てをいろいろ考えられるように早くなりたいです。
本屋で毎日立ち読みしていいコード例がないか読み漁りましたが、なかなかありませんね。
ありがとうございました。
今後もVBAは使用しますので、また何かありましたら助けて頂けますと大変
ありがたいです。


	【72438】Re:再：２つのシートのデータを照合し列...

kiki - 12/8/9(木) 23:22 -


	引用なし

	パスワード

kanabun さん

>ごめんなさい。「入力規則」の数式がまちがってました。
>
>>直前で追加した「抽出リスト」シート
>>ですが、
>>この[A2:A1000]範囲を選択して
>>メニュ－[ツール]-[入力規則...]で、
>>　　入力値の種類：ユーザー設定
>>　　数式　： Countif($A$2:A2)<2　　 ←誤
> 　　数式　： =Countif($A$2:A2,A2)=1　　 ← 正
>>としておくと、
>>重複したアイテムを入力できなくなります。

教えていただいてありがとうございます。
このように変更してみます。

ありがとうございました。


	【72439】Re:再：２つのシートのデータを照合し列...

kanabun - 12/8/10(金) 9:18 -


	引用なし

	パスワード

▼kiki さん： >実は、抽出リストを使わない案が上手く動かなかったのですが、 >（どこが、とういのは控えるのを忘れてしまったのですが） > プリントしたコードを入力しているため私の記載に誤りが > あったのかもしれませんのでまたもう一度やってみます。印刷物から手入力されているんですか？それはなぜですか（VBAコードに慣れるためですか）「うまく動かない」原因の第1位が変数の「タイプミス」（打ちそこない）だってことご存知でしたか？（←出典不明）人間だからタイプミスはどんなエキスパートでもあります。これを防ぐ方法があります。それはモジュールの先頭に Option Explicit これを宣言しておくことです。そうすると、実行前にプログラムのコンパイルしたときに VBA予約語か「宣言された変数」以外があると、「宣言してない変数が使われています」とそれをVBEが指摘してくれますので、このお助け機能は大いに利用しましょう。 Option Explicit は、VBE[ツール] メニューの [オプション] をクリックし、 [編集] タブの [変数の宣言を強制する] チェックボックスをオンにしておくことで、新規モジュールを開くといつも自動で宣言してくれるようになります。 >抽出リスト案のものはしっかりと動きました！それはよかった ♪ >また、フィルタオプションも教えて頂いて恥ずかしながら初めて使いました。 >便利なんですね～。他業務にも活かせそうです。そうなんですよ。 100なり200なりの抽出リストがありこれを参照して元表からリストにあるものだけを抽出（転記）できることを知ってしまうと(^^)、もうリストをひとつづつLoopで検索させるなんてやってられなくなります ♪ >個人的には、抽出リストに入力が一番いいのですが・・・。 >シートを他部署共同で運用するため許可が降りるか・・。 kiki さん、処理を実行したら、書き込んでおいた「抽出リスト」が抽出されたデータで上書きされてしまう！なんて仕様、いったいだれが承認できますか！？よ～く考えて、合理的な効率的な仕様を考えて（もらって）ください。おねがいします。（←他人事ですが）(^^


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

1713 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free