エクセルで抽出結果を別シートにコピーするマクロ

質問

はじめまして質問させていただきます。

タイトルの操作方法を探していたところ
過去にこちらで投稿されていた質問 （QNo.2142846）の
回答（ANo.1）を見つけましたので、実行してみました。

抽出条件★　地域名
　　　　　　　　　東京
　　　　　　　　　東京西
　　　　　　　　　東京東　（など約１００の地域があります）

※当方、全くの初心者で
マクロの内容は回答（ANo.1）のマクロをそのままお借りしています。

途中でエラーがでるなどはないのですが、処理結果を確認したところ
東京シートの中に東京西があったりします。
どれも最初の文字が東京となっているから混乱してるのかな
と思うのですが、これを回避する方法はあるのでしょうか？
（完全一致するものをシートにコピーする、みたいな）

どうぞよろしくお願いいたします。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

とても残念な結果だと思います。

うまく行かない理由は、それは、位置の違いだと思います。
ともかく、エラーメッセージが出ないとしたら、とりあえず、問題は発生していないということになります。

こちらも思惑で作っていますので、位置関係自体は、確認していません、出来れば、コードのいくつかの時点で、正しく値を確保しているか、チェックすればよいのですが。

ただ、もう、成功しているなら、あえて、どちらでもよいことだと思います。

ただ、お使いになっているコードは、最近、似たようなコードは見かけますが、私ならあちこち直したいなって思います。こちらのコードが一発で動かないなら、何を書いても、話なんかにはなりませんけれどね。（^^;

このチェックの仕方は、フィルタオプションを、手動でやっていただくしかありません。こちらでは、どうしようもないことです。あえて、無理強いはしません。しょうがないです。

'r列MyRow行の文字をp2に
Range("p2") = Cells(MyRow, "r")
　　　↓
Range("p2").FormulaLocal = "=IF(A2=""" & Cells(MyRow, "r").Value & """,TRUE)"

P1 は、何も入れてはいけません。（文字が入っていれば出来ません）
P2 に、=IF(A2="東京西",TRUE)
で、A1 が、タイトル行で、A2 が、データの場合になりますが、False で、フィルタオプションで抽出が出来るかどうか？

私のほうのコードは、VBE の左の縁のところをクリックすると、●のブレークポイントがつきますから、そこで、とめて、ローカルウィンドウで変数をクリックして値の中身を調べてもらうしかありませんね。

ポイントとなる部分は、
　Places　'この中身

　シートをクリア
●　　　　For i = 1 To ListCount

ここでポイントになるのは、オートフィルタで抽出が出来ているか？
　　　　.AutoFilter.Range.Copy Worksheets(Places(i, 2)).Range("A1")
●　　　　Next i
　　　　.AutoFilterMode = False

ということになるかと思います。

お礼

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

まだ作っていただいたコードは成功にならないのですが
ひとつずつ単語を調べて解読を進めております。
質問欄で出したコードにも少しだけですが
改良（ErrHandler の処理）を加えてみました。
１行ごとにチェックを行う操作方法もやっと知ったばかりで
だいぶ時間もかかりそうですが、頑張ろうと思っています。

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

回答No.2

Wendy02

こんばんは。

>問題の東京を含む地域名以外は問題なく別シートにコピーされていました。

まず、この問題ですが、その部分は、Excel 2002用のコードで、他のバージョンでは適用されません。私は、本来は、この2002用の書き方が正しいと思うのですが、MS側は、変えてしまいました。おそらく、ユーザークレームで、直してしまったのだろうと思います。

'r列MyRow行の文字をp2に
Range("p2") = Cells(MyRow, "r")
　　　↓
Range("p2").FormulaLocal = "=IF(A2=""" & Cells(MyRow, "r").Value & """,TRUE)"

と直せば出来るようになるとは思います。

以下は、私が考えたコードです。使わなくても結構ですが、一度、コードだけでも見てください。私は、最近、頭を使うコードはあまり書かないようにしています。ほとんど、規定のパターンしか使っていません。

「地域名」と「シート名」とがきちんと整理されているなら、問題なく出来ます。もしも、シート名がない場合は、新たに付け加えられます。ただし、報告によると、誤動作するバージョンなのかブックがあるらしいのですが、今、それを特定できません。

誤動作する部分は、.AutoFilter.Range.Copy　なのですが、Excel2000とExcel2003でしか知らないので、もし、その場合は、

.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

となるわけですが、このバグにも似た問題は、何が原因なのか、未だに解決していません。

------------------------------------------------------

Sub PickupData2SheetsCopy2()
　　Dim Places As Variant
　　Dim ListCount As Integer
　　Dim i As Integer
　　On Error GoTo ErrHandler

　　Application.ScreenUpdating = False
　　With Worksheets("元データ")
　　　　.Activate
　　　　.AutoFilterMode = False 'フィルターモードが邪魔になる
　　　　'地域名リスト
　　　　Places = .Range("R2", .Range("R65536").End(xlUp).Offset(, 1)).Value
　　　　ListCount = UBound(Places, 1)　'リストカウント

　　　　'シートをクリア
　　　　For i = 1 To ListCount
　　　　　　Worksheets(Places(i, 2)).Cells.ClearContents '2はシート名
　　　　Next i

　　　　'データをコピー
　　　　For i = 1 To ListCount
　　　　　　'地域名でオートフィルタ
　　　　　　.Range("A1").CurrentRegion.AutoFilter Field:=1, _
　　　　　　Criteria1:="=" & Places(i, 1), _
　　　　　　Operator:=xlAnd
　　　　　　.AutoFilter.Range.Copy Worksheets(Places(i, 2)).Range("A1")
　　　　Next i
　　　　.AutoFilterMode = False
　　End With
　　Application.ScreenUpdating = True
ErrHandler:
　　If Err.Number = 9 Then
　　Worksheets.Add After:=Sheets(Sheets.Count)
　　ActiveSheet.Name = Places(i, 2)
　　Worksheets("元データ").Activate
　　Resume Next
　　ElseIf Err.Number > 0 Then
　　　MsgBox "Err:" & Err.Number & " " & Err.Description & vbCrLf & _
　　　　　　 "エラーが発生しましたので、終了します。", vbInformation
　　End If
End Sub

お礼

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

実は、私は自分でマクロを組んだことが一度もなく、
最初に投稿したコードの内容を理解するまでに
何時間もかかったくらいの初心者レベルでして。
こんなに丁寧な回答をしていただいたのに
自分の理解力以上の質問をしてしまったのではないかと少し反省しております。
今は、作っていただいたコードの単語を１つずつ調べています。
ゆっくりでもマクロに取り組んでいきたいと思っています。
★★★

'r列MyRow行の文字をp2に
Range("p2") = Cells(MyRow, "r")
　　　↓
Range("p2").FormulaLocal = "=IF(A2=""" & Cells(MyRow, "r").Value & """,TRUE)"

もうひとつ、Wendy02 様に考えていただいたコードも実行したところ
タイトル行のみがコピーされ、抽出結果は表示されませんでした。

抽出条件は文字じゃない方がいいのかなと思いまして
地域名ごとに数字を割り当て（地域コードを作ってみました）
質問で表示したマクロを実行すると、全てコピーすることができました。
期限付きの仕事のオーダーでしたので、
とりあえず・・というカタチで終了しております。

回答No.1

Wendy02

こんにちは。

>過去にこちらで投稿されていた質問 （QNo.2142846）の回答（ANo.1）を見つけましたので、実行してみました。

私も以前書いたのですが……。

もう一度、改めて、質問の要件を出していただいたほうがよいのかなって思います。
とても、前の方のマクロを使ったり修正というようなアテ推量なコードを書くことは出来ませんからね。確実性がほしいのです。

ソース・シート
　　　　　A　　　　B
　　　　地域名　　売上　
　　　　東京　　　10,000
　　　　東京西　　12,000
　　　　東京東　　　8,000

というような感じで、シート名を、それぞれの地域名にして、売上をそのシートのB列あたりにコピーするのですか？

ただ、「約１００の地域」となると、おそらくは、途中でうまくいかなくなるような気がします。私は、シートの限界数を、40前後と考えています。空のシートなら、100以上も可能なのですが。

作り方は、オートフィルタで、それぞれを抽出して、それぞれのシートにコピーするだけです。

補足

Wendy02 様　回答ありがとうございます。
分かりにくい質問の仕方で大変申し訳ありませんでした。
もう一度はじめから質問させていただきますので、よろしくお願いいたします。
★したいこと★
【元データSheet】 のデータを地域名ごとにオートフィルタして、その抽出結果を
各地域名のsheet（同じブック内に用意しています/約１００シート）にコピーするマクロを作成したい。
★つまづいたところ★
マクロを実行すると、【東京Sheet】の中に"東京西"のデータが入ってしまう。
（今のコードでは抽出条件が "東京を含む" のような意味になっている？）

↓以下、元データの内容です。
　　　Ａ　　　Ｂ　　　　　　　　　Ｐ　　　　Ｒ　　　　Ｓ　
１　地域名　数量　　　　　　地域名　地域名　　シート名
２　東京　　１　　　　　　　　東京　　東京　　　　東京
３　東京西　２　　　　　　　　　　　　東京西　　　東京西
４　東京　　２　　　　　　　　　　　　神戸　　　神戸

抽出したいＡ列のフィールド名"地域名"をＰ１に記入してＰ２に"東京"を仮に入れています。
Ｒ列に抽出したい地域名を縦に列挙しておきます。
Ｓ列には「東京」で抽出したデータを「東京Sheet」にコピーするというように、対応するコピー先ワークシートの名前を記述します。

↓以下、コードです。コメントは私が勝手に解釈した内容です。
Sub 抽出結果を別シートにコピー()

Dim MyRow As Long
Application.ScreenUpdating = False
MyRow = 2

'地域名シートの初期化→　s列MyRow行のSheet をクリア

Do Until Sheets("元データ").Cells(MyRow, "r") = ""
　 Sheets(Sheets("元データ").Cells(MyRow, "s").Text).Select
　Cells.Select
　Selection.ClearContents
　MyRow = MyRow + 1
Loop

Sheets("元データ").Activate
MyRow = 2

'抽出結果をシートにコピー
Do Until Cells(MyRow, "r") = ""

'r列MyRow行の文字をp2に
Range("p2") = Cells(MyRow, "r")

'(p1:p2)を抽出条件にして、オートフィルタ。結果をs列MyRow行のSheetのa1にコピー
Range("a1").CurrentRegion.AdvancedFilter xlFilterCopy, Range("p1:p2"), Sheets(Cells(MyRow, "s").Text).Range("a1")
MyRow = MyRow + 1

Loop
Application.ScreenUpdating = True
End Sub

９５個シートを作り実行したところ、問題の東京を含む地域名以外は
問題なく別シートにコピーされていました。
長くて余計見ずらくなりましたが、よろしくお願いいたします。