質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.90%

VBAでのループ上書き処理について

解決済

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 196

arrr_wand

score 0

前提・実現したいこと

資金繰りのVBAを作成しています。
知人から送られてきたプログラムの続きを作成しているのですが、理解が追い付いておらず作成が思うようにすすんでおりません。

実現したいこととしては、画像にあるHOMEシートの更新ボタンを押すと口座シートの科目に沿って値が反映されて計算してくれるというものです。
また、HOMEシートの支出・収益の項目は追加されることがあります。
イメージ説明

発生している問題・エラーメッセージ

HOMEシートの計算式を呼び出す文と、支出の中の項目数(通信費~消耗品費(動的にあとから追加される分含め))+1行空けて収益の中の項目数(これもあとから追加されます)+1行空けて集計というfor文の書き方がわかりません。

該当のソースコード

Sub Auto_Open()
    'Deleteキーを押したときに、特定の関数を実行
    Application.OnKey "{DEL}", "PressDelKey"
End Sub

Sub Auto_Close()
    'Deleteキーを押した際の関数実行を中止
    Application.OnKey "{DEL}"
End Sub

Private Sub PressDelKey()

    'セルを指定している時だけ警告を表示
    If UCase$(TypeName(Selection)) = "RANGE" Then
    End If

End Sub
' 行を追加
Sub InsertCategory(categoryName As String, categoryType As String)
With Sheets("HOME")

   Dim InsertRow As Integer

        Dim i As Integer

             For i = 7 To .Cells(Rows.Count, 1).End(xlUp).Row

             If .Cells(i, 1).Value = categoryType Then


               InsertRow = .Cells(i + 1, 2).End(xlDown).Row + 1

            Exit For

            End If

        Next



        .Range(.Cells(InsertRow, 1), .Cells(InsertRow, 14)).Insert CopyOrigin:=xlFormatFromLeftOrAbove
        .Range(.Cells(InsertRow, 1), .Cells(InsertRow, 14)).Value(xlRangeValueXMLSpreadsheet) = .Range(.Cells(InsertRow - 1, 1), .Cells(InsertRow - 1, 14)).Value(xlRangeValueXMLSpreadsheet)
        .Cells(InsertRow, 2).Value = categoryName



End With

End Sub

Sub sample7()
Call InsertCategory("テスト", "支出")
End Sub

Sub sample5(categoryRow As Integer)

    Dim calcstr As String

    Dim i As Integer
    Dim j As Integer

    With Sheets("銀行情報")
    For i = 1 To 12

              If i <= 2 Then

                    calcstr = "=SUMIFS(" & .Cells(4, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                    .Cells(4, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                    Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                    .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """>=" & 9 + i & "/01""," & _
                    .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """<" & 10 + i & "/01"")"

                For j = 5 To .Cells(Rows.Count, 1).End(xlUp).Row

                    calcstr = calcstr & "+SUMIFS(" & .Cells(j, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                    Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """>=" & 9 + i & "/01""," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """<" & 10 + i & "/01"")"

                Next


            ActiveSheet.Cells(categoryRow, 2 + i).Value = calcstr

               ElseIf i = 3 Then

                     calcstr = "=SUMIFS(" & .Cells(4, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                     .Cells(4, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                      Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                    .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """>=" & 9 + i & "/01""," & _
                    .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                      """<=" & 9 + i & "/31"")"

                For j = 5 To .Cells(Rows.Count, 1).End(xlUp).Row

                    calcstr = calcstr & "+SUMIFS(" & .Cells(j, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                    Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                       """>=" & 9 + i & "/01""," & _
                     .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                     """<=" & 9 + i & "/31"")"

                Next


              ActiveSheet.Cells(categoryRow, 2 + i).Value = calcstr


             ElseIf i >= 4 Then

                      calcstr = "=SUMIFS(" & .Cells(4, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                      .Cells(4, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                     Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                     .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                     """>=" & i - 3 & "/01""," & _
                     .Cells(4, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                      """<" & i - 2 & "/01"")"

                For j = 5 To .Cells(Rows.Count, 1).End(xlUp).Row

                    calcstr = calcstr & "+SUMIFS(" & .Cells(j, 1).Value & "!" & Cells(5, 8).Address(False, False) & ":" & Cells(Rows.Count, 8).Address(False, False) & "," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 5).Address(False, False) & ":" & Cells(Rows.Count, 5).Address(False, False) & "," & _
                     Sheets("HOME").Cells(categoryRow, 2).Address(False, False) & "," & _
                   .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """>=" & i - 3 & "/01""," & _
                    .Cells(j, 1).Value & "!" & Cells(5, 3).Address(False, False) & ":" & Cells(Rows.Count, 3).Address(False, False) & "," & _
                    """<" & i - 2 & "/01"")"

                Next


                  ActiveSheet.Cells(categoryRow, 2 + i).Value = calcstr

             End If

         Next

     End With

End Sub

Sub sample6()

    Call sample5(ActiveCell.Row)

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

check解決した方法

0

認識の誤りがありました。かいけつしております。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.90%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る