
エクセル2010で1シートのデータを項目別に別シートへ自動的に分割する方法で困っています。
検索するとマクロを使うと書いていますが、マクロはほとんど使ったことが無いのもあって、わかりませんでした。
シート1
A列(日付8ケタ+商品番号6ケタ) B列(売上額)
20130515000004 300
20130515000006 100
20130518000004 300
20130519000001 500
20130519000004 300
・・・ ・・・
をA列の日付部分上8ケタを使って日別にシートを分け、
シート名をuriage20130515(uriageと日付8ケタ)という名前にしシート名+CSV形式で保存したいです。
シート2 シート名:uriage20130515
A列 B列
20130515000004 300
20130515000006 100
シート3 シート名:uriage20130518
A列 B列
20130518000004 300
シート4 シート名:uriage20130519
A列 B列
20130519000001 500
20130519000004 300
このように自動で別シートに分割した上で、シート名CSV形式で保存まで自動でできるとありがたいです。
自動化できるならシートを分割するマクロ、シート名でCSV保存するマクロが一つのマクロになっていても、分かれていてもOKです。
このようなことはできますか?
よろしくお願いします。
No.3ベストアンサー
- 回答日時:
手順:
元データのブックを一度保存して開き直す
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける
sub macro1()
dim myPath as string
dim myFile as string
dim h as range
dim s as string
dim w as worksheet
mypath = thisworkbook.path & "\"
on error resume next
kill mypath & "*.csv"
application.displayalerts = false
for each w in worksheets
if w.name <> activesheet.name then w.delete
next
application.displayalerts = true
on error goto errhandle
for each h in range("A1:A" & range("A65536").end(xlup).row)
if isnumeric(h.value) then
s = left(h.value, 8)
’CSVに書き出し
open mypath & "uriage" & s & ".csv" for append as #1
print #1, h.value & "," & h.offset(0,1).value
close #1
’シートに書き出し
h.entirerow.copy worksheets(s).range("A65536").end(xlup).offset(1)
end if
next
for each w in worksheets
w.columns("A:B").autofit
next
exit sub
errhandle:
worksheets.add after:=worksheets(worksheets.count)
activesheet.name = s
range("A1:B1") = array("date", "value")
resume
end sub
ファイルメニューから終了してエクセルに戻る
ALT+F8を押しマクロを実行すると,CSVを書き出す。
#「CSVを書き出す」のが目的で「別シートに振り分ける」こと自体に目的はないと思いましたが,まぁご相談なのでシートに書き出しも追加しました。。。と思って書き足してったら無駄に長いマクロになっちゃいました。あんまりイミなかったです。
ご回答ありがとうございます。
このマクロで処理が完了しました。
>「CSVを書き出す」のが目的で「別シートに振り分ける」こと自体に目的はないと思いましたが
その通りでした。説明がうまくなくすみません。
解決できてよかったです。ありがとうございました。
No.2
- 回答日時:
uriage20130515等の各日付のシートが、前もって手作業で作成されている場合には、マクロを使わずとも通常のワークシート関数でも日付ごとにデータを分けて抽出する事は可能です。
まず、uriage20130515シートのA1セルに次の関数を入力して下さい。
=IF(ISNUMBER(REPLACE(CELL("filename",A1),1,FIND("]",CELL("filename",A1),FIND(".xls",CELL("filename",A1)))+LEN("uriage"),)+0),REPLACE(CELL("filename",A1),1,FIND("]",CELL("filename",A1),FIND(".xls",CELL("filename",A1)))+LEN("uriage"),)+0,"")
次に、uriage20130515シートのA1セルの書式設定の表示形式を[ユーザー定義]の
0000"年"00"月"00"日の売上"
として下さい。
次に、uriage20130515シートのA3セルに次の関数を入力して下さい。
=IF(ROWS($2:2)>COUNTIF(Sheet1!$A:$A,">="&$A$1*1000000)-COUNTIF(Sheet1!$A:$A,">="&($A$1+1)*1000000),"",SMALL(Sheet1!$A:$A,ROWS($2:2)+COUNTIF(Sheet1!$A:$A,"<"&$A$1*1000000)-COUNTIF(Sheet1!$A:$A,"<1")))
次に、uriage20130515シートのB3セルに次の関数を入力して下さい。
=IF($A3="","",VLOOKUP($A3,Sheet1!$A:$B,2,FALSE))
次に、uriage20130515シートのA3~B3の範囲をコピーして、同じ列範囲の4行目以下に貼り付けて下さい。
次に、uriage20130515シートのコピーシートを作成して、それらのコピーシートのシート名を変更して、他の日付のシートを作成して下さい。
或いは、既に他の日付のシートが作成済みである場合には、uriage20130515シートのA列~B列の範囲をまとめてコピーして、他の日付のシートのA列~B列に貼り付けて下さい。
これで、日付ごとにデータを分けて表示させる事が出来ます。
尚、上記の方法は、Sheet1のA列に入力されている「日付+商品番号」の中に、同じ値が重複して入力されていない事が前提となっております。
ですから、もし、「日付+商品番号」の中に、同じ値が重複して入力されている事もあり得る場合には、補足欄等を使用してその旨を御教え頂けましたら、それに対応する方法を回答させて頂きます。

ご回答ありがとうございます。
uriage20130515などのシートが無い上に、件数が5万件程度あるデータだったので
この方法はあきらめましたが「マクロでなくても・・・」というやり方もあるのですね。
勉強になりました。
ありがとうございました。
No.1
- 回答日時:
こんいちは!
CSV形式で保存は手作業でもできると思いますので、
前半の別Sheetに振り分けだけのVBAです。
前提条件
(1)Sheet見出しの一番左が側Sheetに元データがある
(2)1行目は項目行でデータは2行目以降にある
上記前提で標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。
Sub Sample1() 'この行から
Dim i As Long, k As Long, endRow As Long, wS As Worksheet
Application.DisplayAlerts = False
If Worksheets.Count > 1 Then
For k = Worksheets.Count To 2 Step -1
Worksheets(k).Delete
Next k
End If
With Worksheets(1)
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").Insert
With Range(.Cells(2, "A"), .Cells(endRow, "A"))
.Formula = "=LEFT(B2,8)"
.Value = .Value
End With
Range(.Cells(1, "A"), .Cells(endRow, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
Worksheets.Add after:=Worksheets(1)
.Range("A:A").Copy Worksheets(2).Range("A1")
Worksheets(2).Range("A1").Sort key1:=Worksheets(2).Range("A1"), order1:=xlAscending, Header:=xlYes
For i = 2 To Worksheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set wS = Worksheets(Worksheets.Count)
.Range("A1").AutoFilter field:=1, Criteria1:=Worksheets(2).Cells(i, "A")
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Cells(1, "B"), .Cells(endRow, "C")).Copy wS.Range("A1")
wS.Name = "uriage" & Worksheets(2).Cells(i, "A")
wS.Columns.AutoFit
Next i
.AutoFilterMode = False
.Range("A:A").Delete
End With
Worksheets(2).Delete
Application.DisplayAlerts = True
MsgBox "処理完了"
End Sub 'この行まで
※ じっくり考えればもっと簡単になるかもしれませんが、
とりあえずはこの程度で・・・m(_ _)m
ご回答ありがとうございます。
本件はCSVの保存というのが最終目的だったのですが、シートを分けることがいると思い込んでいたのでタイトルから質問内容とふさわしくなかったです。
シートを振り分けるお答えをいただき申し訳ありません。
一番早い回答ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【マクロ画像あり】❶1つの条件...
-
【マクロ】【画像あり】❶ブック...
-
【マクロ】既存ファイルの名前...
-
【画像あり】オートフィルター...
-
エクセルの関数について
-
【マクロ】左のブックと右のブ...
-
【マクロ】元データと同じお客...
-
エクセルのVBAで集計をしたい
-
Office2021のエクセルで米国株...
-
【マクロ】実行時エラー '424':...
-
エクセルのリストについて
-
【マクロ】数式を入力したい。...
-
【マクロ】【相談】Excelブック...
-
他のシートの検索
-
【マクロ】変数に入れるコード...
-
【マクロ】【配列】3つのシー...
-
vba テキストボックスとリフト...
-
【マクロ】【画像あり】ファイ...
-
エクセルの複雑なシフト表から...
-
5単位で繰り上げしたい
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【マクロ】元データと同じお客...
-
エクセルの関数について
-
【画像あり】オートフィルター...
-
エクセルのVBAで集計をしたい
-
エクセルのリストについて
-
【マクロ】数式を入力したい。...
-
【マクロ】【相談】Excelブック...
-
Office2021のエクセルで米国株...
-
【マクロ】実行時エラー '424':...
-
他のシートの検索
-
エクセルの複雑なシフト表から...
-
【マクロ】【配列】3つのシー...
-
vba テキストボックスとリフト...
-
【マクロ】左のブックと右のブ...
-
【マクロ】変数に入れるコード...
-
エクセルシートの見出しの文字...
-
【マクロ】別ファイルへマクロ...
-
【関数】同じ関数なのに、エラ...
-
Amazonでマイクロソフトオフィ...
-
ページが変なふうに切れる
おすすめ情報