|
こんな感じでも出来ると思います。
Sub MyData_Ave()
Dim MyR As Range, C As Range
Application.ScreenUpdating = False
With Sheets("Sheet1")
.Rows(1).Insert xlShiftDown
.Range("A1:B1").Value = Array("日付", "Data")
.Range("A1").Subtotal 1, xlAverage, 2, True
Set MyR = .Range("B:B").SpecialCells(3)
End With
For Each C In MyR
With Sheets("Sheet2").Range("A65536").End(xlUp)
.Offset(1).Value = C.Offset(-1, -1).Value
.Offset(1, 1).Value = C.Value
End With
Next
With Sheets("Sheet1")
.Range("A1").RemoveSubtotal
.Rows(1).Delete xlShiftUp
End With
With Sheets("Sheet2")
.Range("A65536").End(xlUp).Resize(, 2).ClearContents
.Rows(1).Delete xlShiftUp
.Activate
End With
Application.ScreenUpdating = True
End Sub
表のつもりなら、せめて項目ぐらい入れておくべきでしょう。
|
|