excel2000でお助けください

質問

関数では、何とかできるのですが、ファイルがとても重くなってしまうので、VBAの記述で対処するコードの記述を教えていただきたいです。

まず添付写真を参照願います。

mainシートに、A列-年月日、B列-時間、C列-データと３列構成の表があります。

一日24行のデータがあり、毎日ずっとデータが更新して下行に増えていきます。

そして、隣のシートに[00時]、さらにその隣に[01時]、[02時]・・・・とシートが[23時]まで計24枚のシートが続いています。

これらのシートは、A列-年月日、B列-データの２列構成です。

ここで、mainのシートのコマンドボタンを押すとカレンダーが表れ、その日をクリックすると

mainシートのそれぞれの年月日と時間に対応するデータを、それぞれの時間に対応するシートに自動で転記させたいです。

たとえば、写真のように、mainシートの2013/8/22の00時のデータが541なので、00時シートの2013/8/22の行のデータの値を、自動で541と表示させたいのです。

mainシートにどういったコードを記述すれば、こういったことが出来るか、教えていただけないでしょうか？

自分では、どうもコードがイメージできず、せめてヒントだけでも教えていただけると助かります。

回答No.4

K Kazz（@JazzCorp） · ベストアンサー

Option Explicit
Sub Sampling()
Dim xName As String
Dim xNum As Long
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
With Worksheets("main").Range("A1")
For xNum = 0 To 23
xName = Format(xNum, "00") & "時"
Debug.Print xName
Worksheets(xName).Delete
Worksheets.Add After:=Worksheets(Worksheets.Count)
Debug.Print ActiveSheet.Name
Worksheets(Worksheets.Count).Name = xName
Worksheets("main").AutoFilterMode = False
.AutoFilter Field:=2, Criteria1:=xName
.Range("A:A,C:C").SpecialCells(xlCellTypeVisible).Cells.Copy Worksheets(xName).Range("A1")
Next
' Worksheets("main").AutoFilterMode = False
.AutoFilter
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

回答No.3

kmetu

VBAを使わずに

mainシートの一番左に一行挿入して
A2に

=IF(B2="","",TEXT(B2,"yyyy/mm/dd")&C2)

と入力して下へ必要なだけコピーしてください。

00時のシートのB2に

=IF(ISNA(VLOOKUP(TEXT(A2,"yyyy/mm/dd")&RIGHT(CELL("filename",A2),LEN(CELL("filename",A2))-FIND("]",CELL("filename",A2))),Sheet1!A:D,4,FALSE)),"",VLOOKUP(TEXT(A2,"yyyy/mm/dd")&RIGHT(CELL("filename",A2),LEN(CELL("filename",A2))-FIND("]",CELL("filename",A2))),Sheet1!A:D,4,FALSE))

と入力して下へ必要なだけコピーしてください。

あとは01時以降のシートで同じ操作をしてください。

回答No.2

bin-chan

ピボットテーブルではだめなんですか？

シート別に分けたあと、どう使うのか気になります。

回答No.1

tsubuyuki

例えば、ワークシート関数で頑張るなら

=INDEX(main!$C$1:$C$100,SUMPRODUCT((main!$A$1:$A$100='00時'!A2)*(main!$B$1:$B$100="00時")*ROW($A$1:$A$100)))

こんな感じでしょうか（mainが100行以内の場合）。

その他、手動でこなそうと思ったら恐らくフィルタを使うことになるでしょう。
mainシート“以外”のシート名で「時間」にフィルタをかけ、
抽出されたものをコピー、該当シートに貼り付け・・繰り返し。
という手順でしょう。

Sub sample()
Dim sh As Long

With Sheets("main").Range("A1")
　　　　For sh = 2 To Sheets.Count
　　　　　　　　Sheets(sh).Cells.Delete
　　　　　　　　.AutoFilter Field:=2, Criteria1:=Sheets(sh).Name
　　　　　　　　.Range("A:A,C:C").SpecialCells(xlCellTypeConstants, 23).Copy
　　　　　　　　Sheets(sh).Range("A1").PasteSpecial Paste:=xlPasteAll
　　　　Next
　　　　.AutoFilter
End With
End Sub

大体、こんな感じになろうかと。
ただし、データ量によってはもしかしたらメモリ不足が出るかもしれません。

参考までにどうぞ。