人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

研究で大量のデータ処理について、困っています。
1月毎で保存された毎時のエクセルデータがあり、行列の並び替えをしたいのですが、
どのようなマクロ処理をしたら良いか、勉強不足で分かりません。
データの処理内容は以下です。

?毎時(24時間)の毎日のデータが、1月毎に区切られた以下のようなブックがあります。

A B C D E F G・・・・
1
2 ●年●月
3 1 2 3 4 ・・・31(日にち)
4 1 ● ● ● ● ・・・・(データ)
5 2 ● ● ● ● ・・・・(データ)


24
(時間)

?上のようなデータを日付と時間を入れ替え、1月ごとではなく、
日付順に全データをくっつけたエクセルを作りたいのです。

A B C D ・・・
1 1 2 3 ・・(時間)
2●/●/● ● ● ● ・・(データ)
3●/●/● ● ● ● ・・(データ)


(日にち)

データは1月毎で10年位(12ブック×10年)が4ケースあります。
これを1ケース1ブックことに行列の並び替えをしたいと思います。
よろしくお願い致します。


●質問者: simasan
●カテゴリ:コンピュータ
✍キーワード:1月 24 エクセル データ マクロ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●100ポイント

この回答では期待通りの結果にならないと思いますので、コメントを有効にしてください。

質問に書かれた表からは、正確なデータの配置が把握できなかったので、下記を想定した例です。

動作条件:

上記の条件であれば、先頭で指定したフォルダ下にあるファイルをすべて統合するようにしています。


 Sub MakeDataBook()
 Const filePath = "D:\DataFiles"  '★ 実際のパスに修正
 Const yearCell = "A2"  '★ 年のデータセル
 Const monthCell = "C2" '★ 月のデータセル
 
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Application.ScreenUpdating = False
 Dim dstWS As Worksheet
 Set dstWS = Workbooks.Add().Worksheets(1)

 Dim wsNum As Long
 Dim xlFile As Object
 
 For Each xlFile In fso.GetFolder(filePath).Files
 If LCase(fso.GetExtensionName(xlFile.Path)) = "xls" Then
 With Workbooks.Open(xlFile.Path)
 With .Worksheets(1)
 .Range("B3").Resize(30, 40).Copy
 dstWS.Range("A1").Offset(40 * wsNum, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
 For i = 40 * wsNum + 1 To 40 * wsNum + 35
 If dstWS.Cells(i, "A") <> "" Then
 dstWS.Cells(i, "A") = DateSerial(.Range(yearCell), .Range(monthCell), dstWS.Cells(i, "A"))
 End If
 Next
 wsNum = wsNum + 1
 End With
 .Close
 End With
 End If
 Next
 
 ' 表の整形
 dstWS.Range("A1").Resize(1, 40).EntireColumn.Sort Key1:=dstWS.Range("A1")
 dstWS.Rows(1).Insert
 dstWS.Range("A1").Resize(1, 24) = Array("", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24")
 dstWS.Range("A1").Resize(1, 24).Interior.ColorIndex = 35
 dstWS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
 
 dstWS.Range("A1").Select
 With ActiveWindow
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 Application.ScreenUpdating = True
End Sub

マクロでうまくいかない部分があったらコメントください。

http://allabout.co.jp/gm/gl/472/

◎質問者からの返答

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

1つ質問です。

動作条件のデータ年月についてですが、

・A2にデータ年、C2にデータ月、データはA3から32×25(実データはB4から31×24)にある。

→B3にデータ年月が入っています。

●年●月のような形式で入っており、文字列扱いになります。

これだと、データの形式が違ってしまって、途中で、マクロがとまってしまいます。

対処法を教えて頂けたらと思います。

初歩的な質問で申し訳ありませんが、

よろしくお願い致します。


2 ● Mook
●100ポイント ベストアンサー

コメントが無効ですので、回答で失礼します。(コメントを有効にお願いします。)

下記の2か所を変更してみてください。

Sub MakeDataBook()
 Const filePath = "D:\DataFiles"  '★ 実際のパスに修正
 Const DateCell = "B2"  '★ 年月のデータセル :★★修正
 
 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Application.ScreenUpdating = False
 Dim dstWS As Worksheet
 Set dstWS = Workbooks.Add().Worksheets(1)

 Dim wsNum As Long
 Dim xlFile As Object
 
 For Each xlFile In fso.GetFolder(filePath).Files
 If LCase(fso.GetExtensionName(xlFile.Path)) = "xls" Then
 With Workbooks.Open(xlFile.Path)
 With .Worksheets(1)
 .Range("B3").Resize(30, 40).Copy
 dstWS.Range("A1").Offset(40 * wsNum, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
 For i = 40 * wsNum + 1 To 40 * wsNum + 35
 If dstWS.Cells(i, "A") <> "" Then
 dstWS.Cells(i, "A") = CDate(.Range(DateCell) & dstWS.Cells(i, "A") & "日") ' ★★修正
 End If
 Next
 wsNum = wsNum + 1
 End With
 .Close
 End With
 End If
 Next
 
 ' 表の整形
 dstWS.Range("A1").Resize(1, 40).EntireColumn.Sort Key1:=dstWS.Range("A1")
 dstWS.Rows(1).Insert
 dstWS.Range("A1").Resize(1, 24) = Array("", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24")
 dstWS.Range("A1").Resize(1, 24).Interior.ColorIndex = 35
 dstWS.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
 
 dstWS.Range("A1").Select
 With ActiveWindow
 .SplitColumn = 0
 .SplitRow = 1
 .FreezePanes = True
 End With
 Application.ScreenUpdating = True
End Sub

http://office.microsoft.com/ja-jp/access/HA012290181041.aspx

◎質問者からの返答

マクロを修正したところ、無事、データ処理、出来ました。

大変、助かりました。

地道に作業したら、ミスはするだろうし、時間もかかるし、

途方にくれていたところでした。

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

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ