[[20161125140017]]　『集計を追加したい』（ふみ）　ページの最後に飛ぶ

『集計を追加したい』（ふみ）

こんにちは。

会社のシステムから売上予定のリストをCSVファイルで出力出来ます。
このファイルの不要なデータを削除してファイルを整形して、
整形後はF列に売価が、G列に利益が記入されているので、
桁区切りをして売価が５０万円以上の場合に赤の太字に書き替えます。

そしてA列に売上予定月が「2016/11/1」「2016/12/1」と入っており、
表示は「Nov-16」「Dec-16」となっています。
この売上予定月のi行目とi+1行目を比較していって月の変わり目を見つけて
４行空白行を入れるところまでは出来ました。

この後、各月毎の売価と利益を集計して、各月の最後の行の下に線を書いて
集計した合計を書きたいのですが、どの様に考えたら良いのか分かりません。
コードを載せますが、幼稚なコードなので全面的に書き変えないと出来ない
場合は仕方無いですが、出来ればこの続きで教えて頂きたいです。

よろしくお願いします。

Sub フォーマット()

Application.ScreenUpdating = False

 Dim CSV_WS As Worksheet                            'CSVが１つだけか確認し、先頭Sheetを指定。無い場合、複数の場合は終了。
 Dim wb As Workbook
 Dim csvCount As Long

    For Each wb In Workbooks
        If InStr(LCase(wb.Name), ".csv") > 0 Then
            Set CSV_WS = wb.Worksheets(1)   '// 先頭シートを指定
            csvCount = csvCount + 1
        End If
    Next

   If csvCount <> 1 Then
        If csvCount = 0 Then MsgBox "CSV ファイルがありません。"
        If csvCount > 1 Then MsgBox "CSV が複数開いています。"

        Exit Sub

    End If

CSV_WS.Activate

Range("B:E").Delete
Columns("C").Delete
Columns("D").Delete
Range("G:J").Delete
Range("H:M").Delete

Columns("C").ColumnWidth = 40
Columns("D").ColumnWidth = 25
Columns("F").ColumnWidth = 12

Dim 最終行 As Integer

 最終行 = Cells(Rows.Count, 6).End(xlUp).Row

 Dim i As Long

 For i = 2 To 最終行

      Cells(i, 6).NumberFormatLocal = "#,###"  '桁区切りをつける
      Cells(i, 7).NumberFormatLocal = "#,###"  '桁区切りをつける

         If Cells(i, 6) > 499999 Then

             Cells(i, 6).Font.ColorIndex = 3  'フォントを赤に
             Cells(i, 6).Font.Bold = True     'フォントを太字に

          End If

  Next i

  For i = 2 To 最終行 + 100

        Application.CutCopyMode = False

          If Cells(i, 1) < Cells(i + 1, 1) Then

              Rows(i + 1).Insert
              Rows(i + 2).Insert
              Rows(i + 3).Insert
              Rows(i + 4).Insert

               i = i + 4

           End If

    Next i

Range("A2").Select

    ActiveWindow.FreezePanes = True

    Application.ScreenUpdating = True

End Sub

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

最後のRange("A2").Select の直前に以下を挿入

  For i = 最終行 + 100 To 2 Step -1
    If Cells(i, 1) & Cells(i + 1, 1) & Cells(i + 2, 1) & Cells(i + 3, 1) = "" And Cells(i - 1, 1) <> "" Then
        Cells(i, 6).Value = Application.Sum(Intersect(Cells(i, 6).Offset(-1).CurrentRegion, Columns(6)))
        Cells(i, 7).Value = Application.Sum(Intersect(Cells(i, 7).Offset(-1).CurrentRegion, Columns(7)))
    End If
  Next i
（mm） 2016/11/25(金) 15:41

mmさん、ありがとう御座います。
完璧に出来ています。

自分でも空白行を作るコードがダサくて調べてみて、空白を入れる時は下からの方が良いと
書いてあったので、コードを変えている途中でした。

空白行を見つけたら、６行目と７行目の空白で囲まれた範囲をCurrentRegionで探すのですね。
以前、この学校でCurrentRegionの質問をしたのに、全然使えてなくて恥ずかしい限りです。

ありがとう御座いました。
（ふみ） 2016/11/25(金) 16:06

６行目、７行目では無く６列目、７列目の間違いです。

お恥ずかしい。。。
（ふみ） 2016/11/25(金) 16:10

最終コードです。罫線も引きました。

 Const 追加行数 As Long = 4

  For i = 最終行 To 2 Step -1

        Application.CutCopyMode = False

          If Cells(i, 1) > Cells(i - 1, 1) Then

             Cells(i, 1).Resize(追加行数).EntireRow.Insert

           End If

    Next i

 For i = 最終行 + 100 To 2 Step -1

    If Cells(i, 1) & Cells(i + 1, 1) & Cells(i + 2, 1) & Cells(i + 3, 1) = "" And Cells(i - 1, 1) <> "" Then

        Cells(i, 6).Value = Application.Sum(Intersect(Cells(i, 6).Offset(-1).CurrentRegion, Columns(6)))

        With Cells(i, 6).Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                        .ColorIndex = 41
        End With

        Cells(i, 7).Value = Application.Sum(Intersect(Cells(i, 7).Offset(-1).CurrentRegion, Columns(7)))

        With Cells(i, 7).Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .Weight = xlThick
                        .ColorIndex = 41
        End With

      End If
  Next i
（ふみ） 2016/11/25(金) 17:02

コメント返信：

[ 一覧(最新更新順) ]

[[20161125140017]] 『集計を追加したい』（ふみ） ページの最後に飛ぶ

[[20161125140017]]　『集計を追加したい』（ふみ）　ページの最後に飛ぶ