小計を区分ごとに分けたいです（2）

前回、同様の質問をさせていただき、
皆様のご回答のおかげで希望する形に近づくことができました。
【前回の質問】https://teratail.com/questions/301281?whotofollow=

更に質問なのですが、
下記の添付資料のように
矢印の示す箇所がF列とG列が逆に表記されてしまいます。
作業区分の合計をF列に、
図面区分の合計（F列の合計）をG列に表記する方法をご教授ください。

そして、黄色に塗った（空白になっている）セルを
消す（上に詰める）ことはできますでしょうか？
（総計の行は消して、合計時間は作業時間合計の横【G列】に表記したいです）
お手数をおかけしますが重ねてご教授をお願い致します。

該当のソースコード

Sub F列の合計のみG列に移動()
'A列の最終行を取得
n = Cells(Rows.Count, "A").End(xlUp).Row
MsgBox n
For i = 2 To n
'A列が空白でない限り実行
'または　If Range("A" & i) <> "" Then
If Cells(i, 1) <> "" Then
MsgBox i 'ここでの[i]は行番号です
Cells(i, 1).Select '結合された全てのセルを選択される
Cells(i, 6).Select '結合されていないのでRange("F" & i)のみ選択
Cells(i, 7).Value = Cells(i, 6).Value
Cells(i, 6).ClearContents
End If
Next i

End Sub

試したこと

Sub E列の合計のみF列に移動()
Dim i As Long
Dim j As Single '作業時間
Dim a As Long '行№

For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
Cells(i, 3).Select
If Cells(i, 3) = Empty Then
j = 0
Else '作業時間の計算開始**************
If j = 0 Then 'ｊが "０"の場合新たに集計する
a = i
j = j + Cells(i, 5).Value 'Ｅ列の作業時間累計確保
Cells(a, 6).Value = j '結合された小計へ転記

Else '上と同じ項目なので累計とる
j = j + Cells(i, 5).Value 'Ｅ列の作業時間累計確保
Cells(a, 6).Value = j '結合された小計へ転記（集計する行番地）
End If
End If
Next i
Call 小計

End Sub
Sub 小計()
Dim n As Long
Dim i As Long
Dim myrow As Integer
Dim m As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To n - 2
If Cells(i, 1) <> "" Then
'結合されたセル行数取得
myrow = Cells(i, 1).MergeArea.Rows.Count
Cells(i, 6).Value = WorksheetFunction.Sum(Range(Cells(i, 5), Cells(i + myrow, 5)))
Cells(i, 7).Value = Cells(i, 6).Value
End If
Next i
'「統計」=Sum関数
Cells(n - 1, 7).Value = WorksheetFunction.Sum(Range(Cells(2, 7), Cells(n - 2, 7)))

End Sub

上記の【Sub E列の合計のみF列に移動()】をマクロに追記してみましたが、
F列の小計がE列に移動してしまい、F列とG列には違う値が表記されてしまいます。

行動規範の内容に同意します

回答4件

前回の質問があるなら、リンクを貼ってみては？
話の流れが分らなくて回答してくれないこともあるかと。
回答してくれるの可能性が少なくなるのは、
質問者にとって損では？

前回の回答で言及してませんでしたが、
「結合されたセル範囲」は左上のセル以外は設定等（値も含む）が無効になっています。
なので、左上のセルだけ注目して（それ以外は無視または除外して）プログラムを組み立てるといいです。

そのうえで、
ステップ実行をしながら、
ローカルウィンドウで変数の中身の変化を確認し、
意図通りに変化しているか確認してください。
そうすることで問題点が見えてくると思います。

追記

「不要な行を削除したい。」ということを見落としていました。
最終的にマクロで形を整えるのですから、
最後の結果が間違いでなければ、どういう手順処理してもよいですよね？
なので、一旦シート上のすべてのセルの結合を解除した方が考え方が簡単ですかね？

ExcelVBA
1'表の成型(不要な行の削除）
2Sub test()
3    Dim rngTable As Range
4    Dim c As Range
5    Dim a As Range
6    Dim b As Range
7    
8    '処理する表のタイトル行を除いたセル範囲の取得
9    With ActiveSheet.Range("A1").CurrentRegion
10        Set rngTable = Intersect(.Cells, .Offset(1))
11    End With
12    
13    '1列目と2列目の前処理
14    For Each c In rngTable.Resize(, 2).Columns
15        c.UnMerge                               'セルの結合を解除
16        Set a = Nothing                             '変数の初期化
17        On Error Resume Next
18        Set a = c.SpecialCells(xlCellTypeBlanks)    'ジャンプ機能で空白セル検索
19        On Error GoTo 0
20        
21        'もし、空白セルがあったら
22        If Not a Is Nothing Then
23            '空白範囲毎に繰り返し
24            For Each b In a.Areas
25                'セル範囲の1行上の値を転記
26                b.Value = b.Cells(0, 1).Value
27            Next
28        End If
29    Next
30    
31    '3列目が空白の行を削除
32    On Error Resume Next
33    rngTable.Columns(3).SpecialCells(xlCellTypeBlanks).EntireRow.Delete    'ジャンプ機能で空白セル検索
34    On Error GoTo 0
35End Sub

まずは、こんな感じで成形して、小計機能やピボットテーブルなどの機能で、
小計や総計を計算できるようにしてやります。
元のデータが変わるので、別のシートにでもコピペして作業するとよいかと思います。
さらに別のシートにピボットテーブルで集計し、
期待した見た目にならなければ、それの結果をまた加工したらよいかと思います。
中間の作業に使ったシートは、削除してしまえば、
マクロを使う人には途中にどんなことをしたかはわからないようになります。
もちろん自作することも可能ですが、
せっかくエクセルを使っているのですから、
エクセルの機能を使うと、自作する労力が減らせ、コードを書く量も減らせます。
（エクセルの機能を調べる方に労力がかかるかもしれませんが。）
今回の場合、小計機能を使ってもいいかもしれませんね。

投稿2020/11/03 03:38

編集2020/11/05 09:42

mattuwan

総合スコア2136

hana0118

2020/11/04 00:53

色々なご配慮、ご教授いただきありがとうございます。前回の質問のリンクを貼らせていただきました。左上のセルに注目して、再度プラグラムを組み立ててみます。

syousuke.33

2020/11/04 12:29

セル黄色塗りつぶしを手動で削除処理してからマクロくみました。確認してみてください

syousuke.33

2020/11/04 14:19

申し訳ございません　再度修正プログラム記載ます

行動規範の内容に同意します

VBA

Sub E列の合計のみF列に移動()
Dim n As Long 'A列最終行
Dim i As Long
Dim j As Single '作業時間
Dim a As Long '行№
Dim y As Long '判定

n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To n
     Cells(i, 2).Select
   
  If Cells(i, 2) = Empty Then 'B列空白の時前のセルと計算********
       Cells(a, 6) = Cells(a, 6) + Cells(i, 5).Value
        y = 1    '判断＝B列空白セル
    
  Else   'B列が空白でない時*****************
        If y = 1 Then a = i '判断＝B列前のセルと計算しない
          Cells(i, 5).Select
           Cells(i, 6) = Cells(i, 5).Value
          a = i
          y = 0
  End If
Next i

Call 小計

End Sub
Sub 小計()
Dim n As Long
Dim i As Long
Dim myrow As Integer
Dim m As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To n - 1
If Cells(i, 1) <> "" Then
'結合されたセル行数取得
Cells(i, 1).Select
myrow = Cells(i, 1).MergeArea.Rows.Count

    Cells(i, 7).Value = WorksheetFunction.Sum(Range(Cells(i, 5), Cells(i + myrow - 1, 5)))
     
End If

Next i
'「統計」=Sum関数
Cells(n, 7).Value = WorksheetFunction.Sum(Range(Cells(2, 7), Cells(n - 1, 7)))

End Sub

投稿2020/11/04 14:32

syousuke.33

総合スコア312

hana0118

2020/11/05 08:37

たくさんのご教授をいただき本当にありがとうございます。教えて頂いたとおりに変更してみましたが、残念ながら表の表記ができませんでした。せっかくご回答いただいたのに申し訳ございません。 syousuke.33さんから色々頂いたヒントを元に、自分でもう少し修正してみます。ありがとうございました。

行動規範の内容に同意します

``イメージ説明](6d24f4051cbc952bfb14fb0763b552ce.png)
コ

Sub E列の合計のみF列に移動()

Dim n As Long 'A列最終行
Dim i As Long
Dim j As Single '作業時間
Dim a As Long '行№
Dim y As Long '判定

n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To n
     Cells(i, 2).Select
   
  If Cells(i, 2) = Empty Then 'B列空白の時前のセルと計算********
       Cells(a, 6) = Cells(a, 6) + Cells(i, 5).Value
        y = 1    '判断＝B列空白セル
    
  Else   'B列が空白でない時*****************
        If y = 1 Then a = i '判断＝B列前のセルと計算しない
          Cells(i, 5).Select
           Cells(i, 6) = Cells(i, 5).Value
          a = i
    
  End If
Next i

Call 小計

End Sub
Sub 小計()
Dim n As Long
Dim i As Long
Dim myrow As Integer
Dim m As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To n - 1
If Cells(i, 1) <> "" Then
'結合されたセル行数取得
myrow = Cells(i, 1).MergeArea.Rows.Count
If myrow = 1 Then myrow = 0
Cells(i, 7).Value = WorksheetFunction.Sum(Range(Cells(i, 5), Cells(i + myrow, 5)))
End If
Next i
'「統計」=Sum関数
Cells(n, 7).Value = WorksheetFunction.Sum(Range(Cells(2, 7), Cells(n - 1, 7)))

End Sub
ード

投稿2020/11/04 12:29

syousuke.33

総合スコア312

'結合されたセル行数取得
myrow = Cells(i, 1).MergeArea.Rows.Count
Cells(i, 6).Value = WorksheetFunction.Sum(Range(Cells(i, 5), Cells(i + myrow, 5)))
~~Cells(i, 7).Value = Cells(i, 6).Value~~
Cells(i,6).Valueの「６」から「７」に変更してください。
プログラムの動作確認の方法はＰＣの画面の左半分をExcelシートを表示、右半分をモジュール画面を表示させ一度モジュール画面の方をクリックしてから
「F8」キーを押してください、「F8」キーを押すと黄色いカーソルが表示されます。F8」キーを押し続けて確認することができます
次に空白のセル（黄色い塗りつぶしセル）を削除した場合マクロが希望道理
に動くか自分で確認してください