日報を週報に変える – リボン日記

Excel で日報データを週報に変えて、長期間のグラフを見やすくしようとした。SUM()関数を使って日報のデータを週報に集計すればいいのだが、手入力で範囲指定するとミスが出るのでVBAで書き出した。

ただし、なぜかVBA でタブが扱えなかったので、区切りが半角スペースになっている。これをテキストエディタの検索置換でタブに変えて、Excel のセルに貼れば、狙った通りの週報に変わる。

条件

セルはB2 とC2から下方向に日報データが並んでいるものとする。

コード

Option Explicit

'// 日報データを週報データに変えるSUM関数をイミディエイトに書き出す
Sub OutWeek()
  '//初期化
  Dim sumNum(5) As String
  Dim cellNum(1) As Long
  Dim ij As Long
  '//=SUM(B2:B8) =SUM(C2:C8)
  '//のように、B列、C列の2行目から日報データを集計する関数を書き出す
  sumNum(1) = "=SUM(B"
  sumNum(2) = ":B"
  sumNum(3) = ")    =SUM(C" '//BとCの間をタブ区切りにしてエクセルのセルに直接貼れるようにしたいが、タブがなぜか半角スペースに変換される
  sumNum(4) = ":C"
  sumNum(5) = ")"
  '//1週間の始まりと終わりの行
  cellNum(0) = 2
  cellNum(1) = 8
  '//53週(371日)分書き出す
  For ij = 1 To 53
    '//文字列と行数を結合してイミディエイトに書き出す
    'Str() で数字を文字列に変換、整数にすると文頭に半角スペースが入るので、CutLeft() で切り取り
    Debug.Print sumNum(1) + CutLeft(Str(cellNum(0)), 1) + sumNum(2) + CutLeft(Str(cellNum(1)), 1) + sumNum(3) + CutLeft(Str(cellNum(0)), 1) + sumNum(4) + CutLeft(Str(cellNum(1)), 1) + sumNum(5)
    '//7日後の行を指定
    cellNum(0) = cellNum(0) + 7
    cellNum(1) = cellNum(1) + 7
  Next ij
End Sub
'// 引数１：文字列
'// 引数２：削除文字数
'// 戻り値：削除後の文字列
Function CutLeft(s, i As Long) As String
    Dim iLen    As Long     '// 文字列長
    
    '// 文字列ではない場合
    If VarType(s) <> vbString Then
        Exit Function
    End If
    
    iLen = Len(s)
    
    '// 文字列長より指定文字数が大きい場合
    If iLen < i Then
        Exit Function
    End If
    
    '// 指定文字数を削除して返す
    CutLeft = Right(s, iLen - i)
End Function

Option Explicit

'// 日報データを週報データに変えるSUM関数をイミディエイトに書き出す

Sub OutWeek()

'//初期化

Dim sumNum(5) As String

Dim cellNum(1) As Long

Dim ij As Long

'//=SUM(B2:B8) =SUM(C2:C8)

'//のように、B列、C列の2行目から日報データを集計する関数を書き出す

sumNum(1) = "=SUM(B"

sumNum(2) = ":B"

sumNum(3) = ") =SUM(C" '//BとCの間をタブ区切りにしてエクセルのセルに直接貼れるようにしたいが、タブがなぜか半角スペースに変換される

sumNum(4) = ":C"

sumNum(5) = ")"

'//1週間の始まりと終わりの行

cellNum(0) = 2

cellNum(1) = 8

'//53週(371日)分書き出す

For ij = 1 To 53

'//文字列と行数を結合してイミディエイトに書き出す

'Str() で数字を文字列に変換、整数にすると文頭に半角スペースが入るので、CutLeft() で切り取り

Debug.Print sumNum(1) + CutLeft(Str(cellNum(0)), 1) + sumNum(2) + CutLeft(Str(cellNum(1)), 1) + sumNum(3) + CutLeft(Str(cellNum(0)), 1) + sumNum(4) + CutLeft(Str(cellNum(1)), 1) + sumNum(5)

'//7日後の行を指定

cellNum(0) = cellNum(0) + 7

cellNum(1) = cellNum(1) + 7

Next ij

End Sub

'// 引数１：文字列

'// 引数２：削除文字数

'// 戻り値：削除後の文字列

Function CutLeft(s, i As Long) As String

Dim iLen As Long '// 文字列長

'// 文字列ではない場合

If VarType(s) <> vbString Then

Exit Function

End If

iLen = Len(s)

'// 文字列長より指定文字数が大きい場合

If iLen < i Then

Exit Function

End If

'// 指定文字数を削除して返す

CutLeft = Right(s, iLen - i)

End Function

文字の切り取りは、この記事のものを使わせてもらった。
VBAで文字列の右側や左側から指定文字数削除する