選択併合
private su sheetmarge(sname as string)
snameはサブルーチんが呼び出されるときに実際の
値が確定。
sub プロシージャーは２回呼び出される。
１度目は銀行預金シート
２度目は現金シート
dp1 dp2 はモジュール全体で有効
Option Explicit
Dim Dp1 As Integer ‘元帳を追加する行番号を保持
Dim Dp2 As Integer ‘手持金を追加する行番号を保持
Const Sp As Integer = 4 ‘定数を定義。追加する際の先頭の行番号
Sub 併合()
Worksheets(“元帳”).Cells(3, 1).CurrentRegion.Offset(1, 0).Clear
Dp1 = Sp ‘4行目から記入
Worksheets(“手持金”).Cells(3, 1).CurrentRegion.Offset(1, 0).Clear
Dp2 = Sp ‘4行目から記入
SheetMarge “銀行預金”
SheetMarge “現金”
End Sub
Private Sub SheetMarge(sName As String)
Dim Ep As Integer, Cc As Integer
Worksheets(sName).Activate
Ep = Cells(Sp, 1).End(xlDown).Row
For Cc = Sp To Ep
If Cells(Cc, 3).Value = “手持ち金” Then
With Worksheets(“手持金”)
Range(Cells(Cc, 1), Cells(Cc, 7)).Copy .Cells(Dp2, 1) ‘.Paste
If Dp2 = Sp Then ‘もし先頭行なら
.Cells(Dp2, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
Else
.Cells(Dp2, 6).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End If
Dp2 = Dp2 + 1
End With
Else
With Worksheets(“元帳”)
Range(Cells(Cc, 1), Cells(Cc, 7)).Copy .Cells(Dp1, 1) ‘.Paste
If Dp1 = Sp Then ‘もし先頭行なら
.Cells(Dp1, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
Else
.Cells(Dp1, 6).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End If
Dp1 = Dp1 + 1
End With
End If
Next Cc
End Sub
