Excelで数値を並べ替えたい

質問

Excelで、A列に西暦年が1960年から20年分、B列に月、C列に日、D列に時刻（1時間単位）、E列に数値が入ったシートがあります。
間には閏年もあります。
7000行強の列があることになります。

これを年ごとに別シート（20シート）に分けたいです。
シート内ではA列に年月日および時刻(1960/1/1 1:00)、B列に元のE列の値を並べます。
複数ファイルあるので、可能ならばファイルごとに列方向（C列、D列、E列…）に順次整列もできればなおありがたいです。

VBAで処理できますでしょうか。
参考になりそうな記述をご教示頂ければ幸いです。

回答No.2

tom04 · ベストアンサー

こんばんは！

とりあえず1Bookだけの操作です。
Sheet2を作業用のSheetとして使用していますので、
最低Sheet数は2つあり、「Sheet2」というSheet名のSheetがあるという前提です。

標準モジュールの一例です。

Sub Sample1()
Dim i As Long, k As Long, endRow As Long, myFlg
Dim Ws1 As Worksheet, wS2 As Worksheet
Set Ws1 = Worksheets("Sheet1") '←元データのSheet
Set wS2 = Worksheets("Sheet2") '←作業用のSheet
Application.ScreenUpdating = False
endRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row
Range(Ws1.Cells(1, "A"), Ws1.Cells(endRow, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
Ws1.Range("A:A").Copy wS2.Range("A1")
Ws1.ShowAllData
wS2.Range("A:A").Sort Key1:=wS2.Range("A1"), Order1:=xlAscending, Header:=xlYes
For i = 2 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
For k = 3 To Worksheets.Count
If Worksheets(k).Name = wS2.Cells(i, "A") & "年" Then
myFlg = True
End If
Next k
If myFlg = False Then
Ws1.Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=wS2.Cells(i, "A")
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = wS2.Cells(i, "A") & "年"
Ws1.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Worksheets(Worksheets.Count).Range("A1")
End If
With Worksheets(Worksheets.Count)
endRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A:A").Insert
.Range("A1") = "年月日 時刻"
With Range(.Cells(2, "A"), .Cells(endRow, "A"))
.Formula = "=DATE(B2,C2,D2)+E2"
.Value = .Value
.NumberFormatLocal = "yyyy/m/d h:mm"
End With
.Range("B:E").Delete
.Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
End With
Next i
wS2.Cells.Clear
Ws1.AutoFilterMode = False
Application.ScreenUpdating = True
MsgBox "処理完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

まさかこんなに長くなるとは…回答頂き感謝しております。試行は後刻になるので、先ずは回答を頂いた御礼まで。ありがとうございました。

回答No.3

bunjii

作業用に1列使えれば関数でも比較的簡単に処理できます。

元のデータがSheet1とします。

結果を求めるシートは任意の名前でかまいません。

G列を作業用として目的の年数をG1セルにセットし、G2セルに次の式を入力します。

=IFERROR(SMALL(IF((Sheet1!$A$2:$A$10000=G$1),ROW($2:$10000),""),ROWS($2:2)),"")

この式は返り値が配列になりますのでCtrl+Shift+Enterで確定します。
G2セルを必要数下へコピーします。

A2セルには次の式を入力し、必要数を下へコピーします。

=IFERROR(DATE(INDEX(Sheet1!A:A,G2),INDEX(Sheet1!B:B,G2),INDEX(Sheet1!C:C,G2))+INDEX(Sheet1!D:D,G2),"")

B2セルには次の式で、同様に必要数を下へコピーします。

=IFERROR(INDEX(Sheet1!E:E,G2),"")

出来上がったシートをコピーしてG1セルの西暦年を入力すれば完了です。

添付画像は同一シート内で試したものです。
尚、元データは日時が順不同になっており、データの行数が少ない状態です。

お礼

試行は後刻になるので、先ずは回答を頂いた御礼まで。お手数をおかけ頂きありがとうございました。

回答No.1

soixante

データが入っているシートがSheet1として、このブックにはこのシートしか入っていないとします。

*************************************************************************
Option Explicit

Sub zzz()
Dim r As Long, c As Integer
Dim i As Integer, j As Integer, k As Integer
Dim Nen As Integer
Dim Lstrow As Long
Dim Ws1 As Worksheet
Set Ws1 = ActiveSheet

Worksheets.Add After:=Ws1, Count:=20
For i = 2 To Worksheets.Count
With Worksheets(i)
.Name = 1958 + i
.Cells(1, 1).Value = "YMDH"
.Cells(1, 2).Value = "Value"
End With
Next i

Application.ScreenUpdating = False

r = 2
Do While Ws1.Cells(r, 1).Value <> ""
With Ws1
Nen = .Cells(r, 1).Value
.Range(.Cells(r, 1), .Cells(r, 5)).Copy
Lstrow = Worksheets(Nen - 1958).Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets(Nen - 1958).Cells(Lstrow, 1).PasteSpecial Paste:=xlPasteAll
End With
r = r + 1
Loop
Application.ScreenUpdating = True

Application.ScreenUpdating = False
For i = 2 To Worksheets.Count
Worksheets(i).Select
j = 2
Do While Cells(j, 1).Value <> ""
Cells(j, 6).Value = DateSerial(Cells(j, 1), Cells(j, 2), Cells(j, 3)) + TimeSerial(Cells(j, 4), 0, 0)
Cells(j, 7).Value = Cells(j, 5).Value
j = j + 1
Loop
Range(Columns(1), Columns(5)).Delete
Cells(1, 1).Value = "YMDH"
Cells(1, 2).Value = "Value"
Columns(1).NumberFormatLocal = "yyyy/m/d h:mm"
Columns.Sort _
Key1:=Cells(1, 1), _
Order1:=xlAscending, _
Header:=xlYes, _
Orientation:=xlTopToBottom
Cells(1, 1).Select
Next i

Worksheets(2).Select
Application.ScreenUpdating = True

Set Ws1 = Nothing
MsgBox "Completed."

End Sub
***********************************************************************

大まかに流れを書くと以下の通りです。
Sheet1の後ろに、新たに20枚シートを作成する。
元データを1行ずつ、それぞれの年にコピペ
データがそれぞれの年のシートにコピーされたら、1960年シートから順に体裁を整えています。
年月日・時刻の統合
Ａ列の昇順並び替え
終了。

＞可能ならばファイルごとに列方向（C列、D列、E列…）に順次整列もできれば
→　ここはちょっと意味が読み取れなかったので対応していません。

7000行ですと若干時間がかかるかもしれません。私も7000行でテストしてみましたが、私のＰＣは少し重いので15秒くらいかかりました。
原始的な方法なのですみませんm(_ _)m

元データのバックアップは必ず取ったうえで試してください。

もっとスマートな回答があればそちらをご参照ください。

お礼

まさかこんなに長くなるとは…回答頂き感謝しております。試行は後刻になるので、先ずは回答を頂いた御礼まで。ありがとうございました。