Option Explicit Dim targetCell As Range Dim da As Date, da2 As Date, da3 As Date Dim number1 As Integer, number2 As Integer, number3 As Integer, number4 As Integer Dim item1 As String, item2 As String, item3 As String Dim penny1 As Long, penny2 As Long, penny3 As Long Dim note As String, subject As String Private Sub CommandButton1_Click() '現金出納簿１　入金ボタン ActiveWindow.ScrollRow = 19 'ウインドウの上端の行を19行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(22, "c").Select 'セルC22を選択する End Sub Private Sub CommandButton2_Click() '現金出納簿　２　出金ボタン ActiveWindow.ScrollRow = 33 'ウインドウの上端の行を33行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(36, "c").Select 'セルC36を選択する End Sub Private Sub CommandButton3_Click() '振替口座　３　会費ボタン ActiveWindow.ScrollRow = 48 'ウインドウの上端の行を48行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(51, "c").Select 'セルC51を選択する End Sub Private Sub CommandButton4_Click() '振替口座　４　一般ボタン ActiveWindow.ScrollRow = 67 'ウインドウの上端の行を67行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(70, "c").Select 'セルC70を選択する End Sub Private Sub CommandButton5_Click() '振替口座　５　振替・現金間移動ボタン ActiveWindow.ScrollRow = 87 'ウインドウの上端の行を87行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(89, "c").Select 'セルC89を選択する End Sub Private Sub CommandButton6_Click() '修正　６　入力済みデータの削除ボタン ActiveWindow.ScrollRow = 100 'ウインドウの上端の行を100行 ActiveWindow.ScrollColumn = 1 'ウインドウの左端の列番号をA Cells(112, "d").Select 'セルD112を選択する End Sub Private Sub 日付入力(targetCell, da) '日付を入力するプロシージャ Do Until targetCell.Value > da Or targetCell.Value = "" 'targetCellの値が変数daより多いか空白になるまで Set targetCell = targetCell.Offset(1, 0) '1行ずつ下がっていく Loop targetCell.Activate '条件に合っているセルを選択 Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow '行を挿入(下の行の書式) Set targetCell = targetCell.Offset(-1, 0) '1行上へ移動して挿入した行へ targetCell.Value = da '変数daを入力 End Sub Private Sub CommandButton7_Click() '入金入力ボタンをクリックしてイベントが発生 Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C22").Value '日付を変数daに代入 number1 = Range("C24").Value '収入科目を変数number1に代入 item1 = Range("C25").Value '入金項目を変数item1に代入 penny1 = Range("C26").Value '入金金額を変数penny1に代入 note = Range("C27").Value '備考を変数noteに代入 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに Set targetCell = Worksheets("収入内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Select Case number1 '収入科目の番号で科目の番号ごとに処理を分岐する。 Case 1 '会費の場合 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "会費" Case 2 '寄付金の場合 Set targetCell = targetCell.Offset(0, 3) 'targetCellを日付から3列右の寄付金の項目へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して寄付金の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "寄付金" Case 3 '雑収入の場合 Set targetCell = targetCell.Offset(0, 5) 'targetCellを日付から5列右の雑収入の項目へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して雑収入の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "雑収入" End Select Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに Set targetCell = Worksheets("現金出納").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 Set targetCell = targetCell.Offset(0, 3) 'targetCellを3列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに Set targetCell = Worksheets("金銭出納簿").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 Set targetCell = targetCell.Offset(0, 4) 'targetCellを4列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 MsgBox ("入力完了。" & vbCrLf & "現金出納・収入内訳・金銭出納簿シートを確認してください。") End Sub Private Sub CommandButton8_Click() '現金出納簿　入金　入力取消ボタンクリック Worksheets("入力").Range("C22,C24:C27").ClearContents '入力した数式と文字を削除する MsgBox ("データをクリアしました。") End Sub Private Sub CommandButton9_Click() '２　出金　の出金ボタンをクリック Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C36").Value '日付を変数daに代入 number2 = Range("C38").Value '支出科目を変数number2に代入 item2 = Range("C39").Value '出金項目を変数item2に代入 penny2 = Range("C40").Value '出金金額を変数penny2に代入 note = Range("C41").Value '備考を変数noteに代入 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに Set targetCell = Worksheets("支出内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Select Case number2 '支出科目の番号で科目の番号ごとに処理を分岐する。 Case 1 '1事業費の場合 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して事業費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "事業費" Case 2 '2通信費の場合 Set targetCell = targetCell.Offset(0, 3) 'targetCellを日付から3列右へ通信費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して通信費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "通信費" Case 3 '3会議費の場合 Set targetCell = targetCell.Offset(0, 5) 'targetCellを日付から5列右へ会議費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会議費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "会議費" Case 4 '4事務費の場合 Set targetCell = targetCell.Offset(0, 7) 'targetCellを日付から7列右へ事業費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "事務費" Case 5 '5消耗品費の場合 Set targetCell = targetCell.Offset(0, 9) 'targetCellを日付から9列右へ消耗品費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "消耗品費" Case 6 '6雑費の場合 Set targetCell = targetCell.Offset(0, 11) 'targetCellを日付から11列右へ雑費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "雑費" End Select Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに Set targetCell = Worksheets("現金出納").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 2) 'targetCellを2列右へ移動して出金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 Set targetCell = targetCell.Offset(0, 2) 'targetCellを2列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに Set targetCell = Worksheets("金銭出納簿").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 3) 'targetCellを3列右へ移動して出金項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して出金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 Set targetCell = targetCell.Offset(0, 2) 'targetCellを3列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 MsgBox ("入力完了。" & vbCrLf & "現金出納・支出内訳・金銭出納簿シートを確認してください。") End Sub Private Sub CommandButton10_Click() '現金出納簿　出金　入力取消ボタン Worksheets("入力").Range("C36,C38:C41").ClearContents '入力した数式と文字を削除する MsgBox ("データをクリアしました。") End Sub Private Sub CommandButton11_Click() '振替口座　会費入金入力ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C51").Value '日付を変数daに代入 item1 = Range("C58").Value '入金項目を変数item1に代入 item2 = Range("C60").Value '出金項目を変数item2に代入 penny1 = Range("C55").Value '受入金額を変数penny1に代入 penny2 = Range("C59").Value '払出金額を変数penny2に代入 note = Range("C61").Value '備考を変数noteに代入 number3 = Range("C53").Value '振替通知票番号number3に代入 Worksheets("振替").Activate 'ワークシート振替をアクティブに Set targetCell = Worksheets("振替").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して振替通知票番号列へ targetCell.Value = number3 'targetCellの内容に振替通知票番号number3を入力 Set targetCell = targetCell.Offset(0, 1) '項目列へ移動 targetCell.Value = item1 '入金項目item1を入力 Set targetCell = targetCell.Offset(0, 1) '受入金額列へ移動 targetCell.Value = penny1 '受入金額penny1を入力 Set targetCell = targetCell.Offset(0, 1) '出金項目列へ移動 targetCell.Value = item2 '出金項目(振替手数料)item2を入力 Set targetCell = targetCell.Offset(0, 1) '払出金額列へ移動 targetCell.Value = penny2 '払出金額penny2を入力 Set targetCell = targetCell.Offset(0, 2) '2列移動して適用列へ targetCell.Value = note '適用noteを入力 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに Set targetCell = Worksheets("収入内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '項目列へ移動 targetCell.Value = item1 '入金項目item1を入力 Set targetCell = targetCell.Offset(0, 1) '受入金額列へ移動 targetCell.Value = penny1 '受入金額penny1を入力 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに Set targetCell = Worksheets("支出内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '出金項目列へ移動 targetCell.Value = item2 '出金項目(振替手数料)item2を入力 Set targetCell = targetCell.Offset(0, 1) '払出金額列へ移動 targetCell.Value = penny2 '払出金額penny2を入力 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに Set targetCell = Worksheets("金銭出納簿").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = "会費・事務費" 'targetCellの内容に科目「会費・事務費」を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して出金項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して出金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 MsgBox ("入力完了。" & vbCrLf & "振替・収入内訳・支出内訳・金銭出納簿シートを確認してください。") End Sub Private Sub CommandButton12_Click() '振替　会費　入力取消ボタン Worksheets("入力").Range("C51,C53,C55,C59:C61").ClearContents '入力した数式と文字を削除する Worksheets("入力").Range("C57").Value = 0 '項目の内訳に0を入力 Worksheets("入力").Range("D57").Value = 0 Worksheets("入力").Range("E57").Value = 0 MsgBox ("データをクリアしました。") End Sub Private Sub CommandButton13_Click() '振替　一般　入金入力ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C70").Value '日付を変数daに代入 number1 = Range("C75").Value '収入科目の番号をnumber1に代入 item1 = Range("C76").Value '入金項目を変数item1に代入 penny1 = Range("C74").Value '受入金額を変数penny1に代入 note = Range("C77").Value '備考を変数noteに代入 number3 = Range("C72").Value '振替通知票番号number3に代入 Worksheets("振替").Activate 'ワークシート振替をアクティブに Set targetCell = Worksheets("振替").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して振替通知票番号列へ targetCell.Value = number3 'targetCellの内容に振替通知票番号number3を入力 Set targetCell = targetCell.Offset(0, 1) '項目列へ移動 targetCell.Value = item1 '入金項目item1を入力 Set targetCell = targetCell.Offset(0, 1) '受入金額列へ移動 targetCell.Value = penny1 '受入金額penny1を入力 Set targetCell = targetCell.Offset(0, 4) '4列移動して適用列へ targetCell.Value = note '適用noteを入力 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに Set targetCell = Worksheets("収入内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Select Case number1 '収入科目の番号で科目の番号ごとに処理を分岐する。 Case 1 '会費の場合 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "会費" Case 2 '寄付金の場合 Set targetCell = targetCell.Offset(0, 3) 'targetCellを日付から3列右の寄付金の項目へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して寄付金の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "寄付金" Case 3 '雑収入の場合 Set targetCell = targetCell.Offset(0, 5) 'targetCellを日付から5列右の雑収入の項目へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して雑収入の金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 subject = "雑収入" End Select Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに Set targetCell = Worksheets("金銭出納簿").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金項目列へ targetCell.Value = item1 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して入金額列へ targetCell.Value = penny1 'targetCellの内容に変数penny1を入力 Set targetCell = targetCell.Offset(0, 4) 'targetCellを4列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 MsgBox ("入力完了" & vbCrLf & "振替・収入内訳シートを確認してください。") End Sub Private Sub CommandButton20_Click() '振替　一般　出金入力ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C70").Value '日付を変数daに代入 number2 = Range("C80").Value '支出科目の番号をnumber2に代入 item2 = Range("C81").Value '出金項目を変数item2に代入 penny2 = Range("C79").Value '払出金額を変数penny2に代入 note = Range("C82").Value '備考を変数noteに代入 number3 = Range("C72").Value '振替通知票番号number3に代入 Worksheets("振替").Activate 'ワークシート振替をアクティブに Set targetCell = Worksheets("振替").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して振替通知票番号列へ targetCell.Value = number3 'targetCellの内容に振替通知票番号number3を入力 Set targetCell = targetCell.Offset(0, 3) '出金項目列へ移動 targetCell.Value = item2 '出金項目(振替手数料)item2を入力 Set targetCell = targetCell.Offset(0, 1) '払出金額列へ移動 targetCell.Value = penny2 '払出金額penny2を入力 Set targetCell = targetCell.Offset(0, 2) '2列移動して適用列へ targetCell.Value = note '適用noteを入力 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに Set targetCell = Worksheets("支出内訳").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Select Case number2 '支出科目の番号で科目の番号ごとに処理を分岐する。 Case 1 '1事業費の場合 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して事業費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "事業費" Case 2 '2通信費の場合 Set targetCell = targetCell.Offset(0, 3) 'targetCellを日付から3列右へ通信費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して通信費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "通信費" Case 3 '3会議費の場合 Set targetCell = targetCell.Offset(0, 5) 'targetCellを日付から5列右へ会議費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会議費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "会議費" Case 4 '4事務費の場合 Set targetCell = targetCell.Offset(0, 7) 'targetCellを日付から7列右へ事業費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "事務費" Case 5 '5消耗品費の場合 Set targetCell = targetCell.Offset(0, 9) 'targetCellを日付から9列右へ消耗品費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "消耗品費" Case 6 '6雑費の場合 Set targetCell = targetCell.Offset(0, 11) 'targetCellを日付から11列右へ雑費の項目列へ targetCell.Value = item2 'targetCellの内容に変数item2を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して会費の金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 subject = "雑費" End Select Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに Set targetCell = Worksheets("金銭出納簿").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して科目列へ targetCell.Value = subject 'targetCellの内容に変数subjectを入力 Set targetCell = targetCell.Offset(0, 3) 'targetCellを3列右へ移動して出金項目列へ targetCell.Value = item2 'targetCellの内容に変数item1を入力 Set targetCell = targetCell.Offset(0, 1) 'targetCellを1列右へ移動して出金額列へ targetCell.Value = penny2 'targetCellの内容に変数penny2を入力 Set targetCell = targetCell.Offset(0, 2) 'targetCellを2列右へ移動して備考の列へ targetCell.Value = note 'targetCellの内容に変数note を入力 MsgBox ("入力完了" & vbCrLf & "振替・支出内訳・金銭出納簿シートを確認してください。") End Sub Private Sub CommandButton14_Click() '振替　一般　入力取消ボタン Worksheets("入力").Range("C70,C72,C74:C76,C77,C79:C82").ClearContents '入力した数式と文字を削除する MsgBox ("データをクリアしました。") End Sub Private Sub CommandButton15_Click() '現金から振替口座への移動ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C89").Value '日付を変数daに代入 number3 = Range("C91").Value '振替通知票番号number3に代入 item3 = Range("C94").Value '移動項目を変数item3に代入 penny3 = Range("C93").Value '受入金額を変数penny3に代入 note = Range("C95").Value '備考を変数noteに代入 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに Set targetCell = Worksheets("現金出納").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '項目列へ移動 targetCell.Value = item3 '移動項目を入力 Set targetCell = targetCell.Offset(0, 2) '出金額列へ移動 targetCell.Value = penny3 '移動金額を入力 Set targetCell = targetCell.Offset(0, 2) '備考列へ移動 targetCell.Value = note '備考を入力 Worksheets("振替").Activate 'ワークシート振替をアクティブに Set targetCell = Worksheets("振替").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '振替通知票番号列へ移動 targetCell.Value = number3 '振替通知票番号を入力 Set targetCell = targetCell.Offset(0, 1) '受入項目列へ移動 targetCell.Value = item3 '移動項目を入力 Set targetCell = targetCell.Offset(0, 1) '受入金額列へ移動 targetCell.Value = penny3 '受入金額を入力 Set targetCell = targetCell.Offset(0, 4) '適用列へ移動 targetCell.Value = note '適用を入力 MsgBox ("入力完了。" & vbCrLf & "振替・現金出納シートを確認してください。") End Sub Private Sub CommandButton16_Click() '振替口座から現金への移動ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに da = Range("C89").Value '日付を変数daに代入 number3 = Range("C91").Value '振替通知票番号number3に代入 item3 = Range("C94").Value '移動項目を変数item3に代入 penny3 = Range("C93").Value '移動金額を変数penny3に代入 note = Range("C95").Value '備考を変数noteに代入 Worksheets("振替").Activate 'ワークシート振替をアクティブに Set targetCell = Worksheets("振替").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '振替通知票番号列へ移動 targetCell.Value = number3 '振替通知票番号を入力 Set targetCell = targetCell.Offset(0, 3) '払出項目列へ移動 targetCell.Value = item3 '移動項目を入力 Set targetCell = targetCell.Offset(0, 1) '払出金額列へ移動 targetCell.Value = penny3 '移動金額を入力 Set targetCell = targetCell.Offset(0, 2) '適用列へ移動 targetCell.Value = note '適用を入力 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに Set targetCell = Worksheets("現金出納").Range("A6") '日付の最初のセルを変数targetCellに代入 Call 日付入力(targetCell, da) '日付入力プロシージャを呼び出す。 '変数targetCell,daを引き渡す。 Set targetCell = targetCell.Offset(0, 1) '項目列へ移動 targetCell.Value = item3 '移動項目を入力 Set targetCell = targetCell.Offset(0, 1) '入金額列へ移動 targetCell.Value = penny3 '移動金額を入力 Set targetCell = targetCell.Offset(0, 3) '備考列へ移動 targetCell.Value = note '備考を入力 MsgBox ("入力完了。" & vbCrLf & "振替・現金出納シートを確認してください。") End Sub Private Sub CommandButton17_Click() '振替　移動　入力取消　ボタン Worksheets("入力").Range("C89,C91,C93:C95").ClearContents '入力した数式と文字を削除する MsgBox ("データをクリアしました。") End Sub Private Sub CommandButton18_Click() '修正　誤入力行の削除　ボタン Worksheets("入力").Activate 'ワークシート入力をアクティブに number4 = Range("D113").Value '作業番号をnumber4へ代入 Select Case number4 '作業番号により作業を分岐する。 Case 1 '現金出納・収入 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに da2 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 If da = da2 Then '変数daとda2が等しいとき Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("収入内訳").Activate 'ワークシート現金出納をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda2が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda2が等しくないとき、警告を出す。 End If Case 2 '現金出納・支出 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに da2 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 If da = da2 Then '変数daとda2が等しいとき Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda2が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda2が等しくないとき、警告を出す。 End If Case 3 '振替・会費 Worksheets("振替").Activate 'ワークシート振替をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに da2 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに da3 = ActiveCell.Value 'アクティブセルの内容を変数da3へ代入 If da2 And da3 = da Then '変数daとda2・da3が等しいとき Worksheets("振替").Activate 'ワークシート振替をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda2が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda2が等しくないとき、警告を出す。 End If Case 4 '振替・一般　入金 Worksheets("振替").Activate 'ワークシート振替をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに da2 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 If da2 = da Then '変数daとda2が等しいとき Worksheets("振替").Activate 'ワークシート振替をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("収入内訳").Activate 'ワークシート収入内訳をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda2が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda2が等しくないとき、警告を出す。 End If Case 5 '振替・一般　出金 Worksheets("振替").Activate 'ワークシート振替をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに da3 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 If da3 = da Then '変数daとda3が等しいとき Worksheets("振替").Activate 'ワークシート振替をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("支出内訳").Activate 'ワークシート支出内訳をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda3が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda3が等しくないとき、警告を出す。 End If Case 6 '現金出納・振替間移動 Worksheets("振替").Activate 'ワークシート振替をアクティブに da = ActiveCell.Value 'アクティブセルの内容を変数daへ代入 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに da2 = ActiveCell.Value 'アクティブセルの内容を変数da2へ代入 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 If da2 = da Then '変数daとda2が等しいとき Worksheets("振替").Activate 'ワークシート振替をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("現金出納").Activate 'ワークシート現金出納をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Worksheets("金銭出納簿").Activate 'ワークシート金銭出納簿をアクティブに ActiveCell.EntireRow.Delete 'アクティブセルの行を削除 Else '変数daとda2が等しくないとき MsgBox "違う行が選択されています。" & vbCrLf & "確認してください。", _ Buttons:=vbCritical, Title:="警告！" '変数daとda2が等しくないとき、警告を出す。 End If End Select MsgBox ("間違って入力しテータを削除しました。") End Sub Private Sub CommandButton19_Click() '修正　入力取消 Worksheets("入力").Range("D113").ClearContents '入力した数式と文字を削除する MsgBox ("データをクリアしました。") End Sub