| |
変更箇所を示します
1、「Public Sub Sample2」の中の
'◆先頭「01係」の行位置（上記の基準からの行Offset）
' Const clngNo As Long = 3
Const clngNo As Long = 1 '★変更
'◆出力表の行見出しを設定
' vntTitle(0) = Array("年実績", "前年比", _
' "達成率", "年実績", "年目標")
' vntTitle(1) = Array("年差益", "前年比", _
' "達成率", "年差益", "年目標")
vntTitle(0) = Array("年実績", "年目標", "年実績", "前年比", "達成率") '★変更
vntTitle(1) = Array("年差益", "年目標", "年差益", "前年比", "達成率") '★変更
lngPitch = UBound(vntTitle(0)) + 1
' vntOffset = Array(0, 3, 4)
vntOffset = Array(2, 0, 1) '★変更
2、「Private Sub OutputTerminate」は全面変更の為、差し替え
'★プロシージャの全面変更
Private Sub OutputTerminate(rngTop As Range, _
vntName As Variant, _
lngYear As Long, _
vntTitle As Variant, _
lngStart As Long)
Dim i As Long
Dim j As Long
Dim lngPitch As Long
Dim vntResult As Variant
Dim vntTmp As Variant
'出力ピッチを取得
lngPitch = UBound(vntTitle) + 1
'行見出し作成用の配列を作成
ReDim vntResult(1 To UBound(vntName, 2) * lngPitch, 1 To 2)
For i = 1 To UBound(vntName, 2)
vntResult(lngStart + (i - 1) * lngPitch + 2, 1) = vntName(1, i)
For j = 0 To UBound(vntTitle)
vntTmp = vntTitle(j)
Select Case j
Case 0
vntTmp = Right(CStr(lngYear - 1), 2) & vntTmp
Case 1, 2
vntTmp = Right(CStr(lngYear), 2) & vntTmp
End Select
vntResult((i - 1) * lngPitch + j + 1, 2) = vntTmp
Next j
Next i
With rngTop
.Value = "係"
'行見出しの出力
.Offset(1).Resize(UBound(vntResult, 1), 2).Value = vntResult
'列見出しの作成
ReDim vntResult(11)
For i = 0 To 11
vntResult(i) = ((i + 3) Mod 12 + 1) & "月"
Next i
.Offset(, 2).Resize(, UBound(vntResult) + 1).Value = vntResult
'算式の代入
For i = 1 To UBound(vntName, 2)
.Offset(lngStart + (i - 1) * lngPitch + 3, 2).Resize(, 12).FormulaR1C1 _
= "=IF(R[-3]C="""","""",ROUND(R[-1]C/R[-3]C,2))"
.Offset(lngStart + (i - 1) * lngPitch + 4, 2).Resize(, 12).FormulaR1C1 _
= "=IF(R[-3]C="""","""",ROUND(R[-2]C/R[-3]C,4))"
Next i
End With
End Sub
|
|
Hirofumi
- 07/5/22(火) 21:35 -
