- 締切済み
データ抜き出し・別シートへ貼付マクロ
WinXP、Office2003を使用しています。 Sheet1に入力されている情報から、下記条件を抜き出し、あらかじめ用意 してある別シートに書き出したいをしたいと思っております。 業務が多く恥ずかしながら手が回らず、少しでも負荷を軽くしたいのですが ご存知の方がいらっしゃいましたらマクロを教えていただけませんでしょうか? なお、1行目にはタイトルが入っており、2行目以降に情報が入っています。 【実施したい処理】 ・B2セルに「/愛知」と入っていたら、A2・B2・C2セルの値を あらかじめ作成してある "/愛知"シートへ書き出す。 ・B2セルに「/東京」と入っていたら、A2・B2・C2セルの値を あらかじめ作成してある "/東京"シートへ書き出す。 ・B2セルに「/大阪」と入っていたら、A2・B2・C2セルの値を あらかじめ作成してある "/大阪"シートへ書き出す。 ※2000行ぐらい情報が入っています。 【イメージ(処理前)】 A列 B列 C列 1行目 A列タイトル B列のタイトル C列のタイトル 2行目 あああ/1234/111 あああ/1234/111/愛知 56789 3行目 ててて/2222/987 ててて/2222/987/東京 11122 4行目 くくく/5467/232 くくく/5467/232/愛知 65656 5行目 ままま/5555/741 ままま/5555/741/大阪 33444 【イメージ(処理後)】 愛知シート A列 B列 C列 1行目 A列タイトル B列のタイトル C列のタイトル 2行目 あああ/1234/111 あああ/1234/111/愛知 56789 3行目 くくく/5467/232 くくく/5467/232/愛知 65656 東京シート A列 B列 C列 1行目 A列タイトル B列のタイトル C列のタイトル 2行目 ててて/2222/987 ててて/2222/987/東京 11122 大阪シート A列 B列 C列 1行目 A列タイトル B列のタイトル C列のタイトル 2行目 ままま/5555/741 ままま/5555/741/大阪 33444 わかりにくくて申し訳ございませんが、よろしくお願い致します。
- みんなの回答 (5)
- 専門家の回答
みんなの回答
- merlionXX
- ベストアンサー率48% (1930/4007)
ANo2-3 merlionXXです。 データが2000件では先ほどのコードでは数秒かかり、多少ストレスがあるかもしれませんね。 検索する都府県が3つだということなのでもっと高速化できるコードに変えてみました。 都府県名のシートが準備されていることが前提ですが。 試してみてください。 Sub test02() Dim myAr() As String, i As Long myAr = Split("愛知,東京,大阪", ",") Application.ScreenUpdating = False With Sheets("Sheet1") For i = LBound(myAr) To UBound(myAr) .Range("A:C").AutoFilter Field:=2, Criteria1:="*/" & myAr(i) .Range("A:C").Copy Worksheets(myAr(i)).Range("A1") Next i .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub
- keithin
- ベストアンサー率66% (5278/7941)
誤記(コピーミスです)があったので訂正しておきます。 失礼しました。 簡易版誤記訂正: sub macro1() worksheets("元データ").select range("A:C").autofilter filed:=2, criteria1:="*/愛知" range("A:C").copy destination:=worksheets("愛知").range("A1") range("A:C").autofilter filed:=2, criteria1:="*/東京" range("A:C").copy destination:=worksheets("東京").range("A1") range("A:C").autofilter filed:=2, criteria1:="*/大阪" range("A:C").copy destination:=worksheets("大阪").range("A1") activesheet.autofiltermode = false end sub なお言わずもがなですが,元のデータ一覧のあるシート名をマクロの中でちゃんと直してから実行してください。 #ここは問題を解決するための掲示板ですから,「お礼のためだけのお礼」は無用に願います。お互いの手間と時間の無駄遣いですので。 まずは実際に試してから「完全にうまくできたので解決しました」とか「実はこうしたらこういう具合になってしまい意図と違っていました」などの,具体的なレスポンスをお願いします。
- merlionXX
- ベストアンサー率48% (1930/4007)
ANo2です。 補足を見ました。 それならば、わたしの書いたコードのままで大丈夫なはずですが試してないのですか?
- merlionXX
- ベストアンサー率48% (1930/4007)
いくつか不明な点があったので、以下の前提でコードを書いてみました。 例には3つの都府県しかないが、実際はもっと多い。 そのため一行ずつ転記する効率の悪い方法です。(笑) 愛知や東京等は一番最後の / の次にあり、そのあとに文字は無い。 Sheet1のB列にある / は全角文字。 なお、 > "/愛知"シートへ書き出す。 とお書きですが、シート名には全角でも/(スラッシュ)は使用できないはずなので、シート名は 愛知 東京 という名のはず。 Sub test01() Dim myC As Range Dim myStr As String With Sheets("Sheet1") For Each myC In .Range("B2", .Cells(Rows.Count, "B").End(xlUp)) myStr = Mid(myC.Value, InStrRev(myC.Value, "/") + 1) On Error GoTo line Sheets(myStr).Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, 3).Value = _ myC.Offset(, -1).Resize(, 3).Value Next End With Exit Sub line: MsgBox "検索文字が見当たらないか転記先のシートが見当たりません。" End Sub
補足
ありがとうございます。 説明不足で申し訳ありません。 ・都道府県は3つのみになります。 ・愛知や東京等は一番最後の / の次に文字はありません。 ・Sheet1のB列にある / は、全角文字です。 ・申し訳ありません、シート名は「愛知」「東京」「大阪」になります。 お手数をおかけしますが、どうぞよろしくお願いいたします。
- keithin
- ベストアンサー率66% (5278/7941)
ワークシートの名前に「/愛知」のようにスラッシュを含ませることは出来ません。 東京,大阪,愛知の各シートに書き出させてみます。 簡易版: sub macro1() worksheets("元データ").select range("A:C").autofilter filed:=2, criteria1:="*/愛知" range("A:C").copy destination:=worksheets("愛知").range("A1") range("A:C").autofilter filed:=2, criteria1:="*/東京" range("A:C").copy destination:=worksheets("東京").range("A1") range("A:C").autofilter filed:=2, criteria1:="*/愛知" range("A:C").copy destination:=worksheets("大阪").range("A1") activesheet.autofiltermode = false end sub "愛知","東京","大阪"をarrayで持たせたり,そもそも何があるのか調べさせてシートを作る所からマクロにやらせるような作り込みもありますが,それは次のステップで実装してください。 #一行ずつ舐め回して転記するような,効率の悪いことはしません。
補足
keithinさん、ありがとうございます。 お礼が遅くなり申し訳ありません。 おっしゃる通り、シート名には「/」はなく、東京,大阪,愛知の 各シートに書き出したかったんです。 説明不足で申し訳ありません。 午後から外に出ておりましたので、まずはお礼だけ入力させていただきます。 月曜日に会社に行って早速試して またご報告をさせて頂きます。
補足
merilionXXさん、ありがとうございます。 お礼が遅くなり申し訳ありません、外に出ておりましたので、 補足だけ入力させていただきました。 月曜日に会社に行って早速試したいと思います! またご報告をさせて頂きます。