| |
VBAの掲示板であることを、承知の上で質問されているとして、いちおうサンプル
を提示しておきます。今年度用のブックを一気に作り上げてしまうマクロです。
任意のブックの標準モジュールに入れて、実行して下さい。
通常、エクセルブックを開くフォルダーに、作成したブックを保存します。
Sub Mk_SalesBook()
Dim Snum As Integer, i As Integer, j As Integer
Dim SvBook As String
Dim WekAry As Variant
Dim WB As Workbook
Dim LsD As Date
With Application
Snum = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 13
SvBook = .DefaultFilePath & "\" & _
Year(Date) & "年度_売上.xls"
.ScreenUpdating = False
End With
If Dir(SvBook) <> "" Then
MsgBox "今年度のブックは作成済みです", 64
GoTo ELine
End If
WekAry = Array("日", "月", "火", "水", "木", "金", "土")
Set WB = Workbooks.Add
For i = 1 To 12
LsD = DateSerial(Year(Date), i + 1, 0)
With WB.Worksheets(i)
.Name = i & "月"
.Range("A1:C1").Value = _
Array(i & "月日付", "曜日", "売上")
.Range("A2").Value = DateSerial(Year(Date), i, 1)
.Range("A2").DataSeries xlColumns, xlChronological, _
xlDay, 1, LsD
With .Range("A2", .Range("A65536").End(xlUp))
.NumberFormat = "dd"
With .Offset(, 1)
.Formula = "=TEXT($A2,""aaa"")"
.Value = .Value
End With
End With
With .Range("A65536").End(xlUp)
.Offset(1).Value = i & "月合計"
.Offset(1, 2).Formula = "=SUM($C$2:$C$" & .Row & ")"
End With
For j = 1 To 7
.Cells(j, 27).Formula = _
"=SUMIF($B:$B," & """" & WekAry(j - 1) & """" & ",$C:$C)"
Next j
End With
Next i
With WB.Worksheets(13)
.Name = "曜日別集計"
.Range("A1").Value = "曜日別集計"
.Range("A2:A8").Value = WorksheetFunction.Transpose(WekAry)
For j = 2 To 8
.Cells(j, 2).Formula = "=SUM(1月:12月!$AA" & j - 1 & ")"
Next j
End With
WB.Close True, SvBook: Set WB = Nothing
MsgBox "今年度の集計ブックを作成しました", 64
ELine:
With Application
.SheetsInNewWorkbook = Snum
.ScreenUpdating = True
End With
End Sub
|
|
Kein
- 06/7/29(土) 16:51 -
