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

前提・実現したいこと

F列に作業区分の小計、G列に図面区分の小計を表記したいのですが、
F列に全ての小計が表記されてしまいます。
G列に図面区分の小計を表記（F列から移動）する方法をご教授ください。

そして、G列の最終行に総計も表記できるようにしたいです。
お手数をおかけしますが重ねてご教授をお願い致します。

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

該当のソースコード

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

Dim r As Long
r = 2
Do While Cells(r, 5).Value <> ""
If Cells(r, 3).Value = "" Then
Cells(r, 6).Value = Cells(r, 5).Value
Cells(r, 5).Clear
End If
r = r + 1
Loop

End Sub

Sub ピポットテーブル作成()

Dim pc As PivotCache
Dim pt As PivotTable

'ピポットキャッシュの作成
Set pc = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Worksheets("AllData").Range("D1").CurrentRegion)

'ピポットテーブル用シートの作成
Worksheets.Add(Before:=Worksheets("AllData")) _
.Name = "集計表"

'ピポットテーブルの作成
Set pt = pc.CreatePivotTable( _
TableDestination:=Worksheets("集計表").Range("A3"), _
TableName:="ピポットテーブル")

'ピポットテーブルの作成
With ActiveSheet.PivotTables("ピポットテーブル")
.CompactLayoutRowHeader = "作業内容"
End With

'必要フィールドの配置
With ActiveSheet.PivotTables("ピポットテーブル")
.PivotFields("図面区分").Orientation = xlRowField
.PivotFields("図面区分").PivotItems("(blank)").Visible = False
.PivotFields("作業区分").Orientation = xlRowField
.PivotFields("作業区分").PivotItems("(blank)").Visible = False
.PivotFields("作業内容").Orientation = xlRowField
End With
ActiveSheet.PivotTables("ピポットテーブル").AddDataField ActiveSheet.PivotTables( _
"ピポットテーブル").PivotFields("時間"), "合計 / 時間", xlSum
With ActiveSheet.PivotTables("ピポットテーブル").PivotFields("時間")
.PivotItems("0.0 ").Visible = False
End With

End Sub

試したこと

Sub C列に列を追加してC1のセルに作業内容D1に資料番号E1に作業時間F1に作業区分小計G1に図面区分小計と入力()

Columns(4).Insert 'C列に列を追加

Range("C1") = "作業内容"
Range("D1") = "資料番号"
Range("E1") = "作業時間"
Range("F1") = "作業区分小計"
Range("G1") = "図面区分小計"

End Sub

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

Dim r As Long
r = 2
Do While Cells(r, 5).Value <> ""
If Cells(r, 3).Value = "" Then
Cells(r, 6).Value = Cells(r, 5).Value
Cells(r, 5).Clear
End If
r = r + 1
Loop

End Sub

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

Dim r As Long
r = 2
Do While Cells(r, 6).Value <> ""
If Cells(r, 2).Value = "" Then
Cells(r, 7).Value = Cells(r, 6).Value
Cells(r, 6).Clear
End If
r = r
Loop

End Sub

上記の【Sub F列の合計のみG列に移動()】をマクロに追記してみましたが、
G列が全て結合されてしまってうまくいきませんでした。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

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

回答5件

ベストアンサー

ＶＢOption Explicit

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

投稿2020/10/31 03:12

syousuke.33

総合スコア312

hana0118

2020/11/02 12:07

syousuke.33さんとても丁寧にわかりやすく回答してくださり、ありがとうございます。お返事が遅くなってしまい申し訳ございません。教えて頂いたとおりに変更してみたところ、希望していたことと一番近い形になりました。また後日あらためて質問させていただきたいと思っております。宜しくお願い致します。

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

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
VBAここに言語を入力
コード

投稿2020/11/02 05:13

syousuke.33

総合スコア312

hana0118

2020/11/02 11:51

ご回答ありがとうございます。お返事が遅くなってしまい申し訳ございません。教えて頂いたとおりに変更してみました。しかし残念ながらF列の小計がE列に移動してしまい、F列とG列には違う値が表記されてしまいます。せっかくご回答いただいたのに申し訳ございません。

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

ExcelVBA
1Sub test()
2    Dim rngData As Range
3    Dim a As Range
4    Dim c As Range
5    
6    'データ本体のセル範囲を取得
7    With ActiveSheet.Range("A1").CurrentRegion
8        Set rngData = .Resize(.Rows.Count - 3).Offset(1)
9    End With
10    
11    '作業区分の小計(2列目が空白の行の塊毎に合計）
12    For Each a In rngData.Columns(2).SpecialCells(xlCellTypeBlanks).Areas
13        Set c = Intersect(a.EntireRow, rngData.Columns(5))
14        c.Cells(0, 2).Value = WorksheetFunction.Sum(c)
15    Next
16    
17    '図面区分の小計(1列目の結合範囲毎に合計）
18    For Each a In rngData.Columns(1).Cells
19        If a.Address = a.MergeArea(1).Address Then
20            Set c = Intersect(a.MergeArea.entirerow, rngData.Columns(5))
21            c.Cells(0, 3).Value = WorksheetFunction.Sum(c)
22        End If
23    Next
24    
25    '総計の計算
26    With rngData
27        .Cells(.Rows.Count + 2, 7).Value = WorksheetFunction.Sum(.Columns(7))
28    End With
29End Sub

2列目は空白セルが小計のキーになるし、
1列目は結合セルが小計のキーになりそうなので、
動作確認してないけど、こんな感じだと思います。

セルはSelectすることが目的でもないし、
Selectしなくてもセルは指定できるので、
Selectしない書き方を覚えましょう。

投稿2020/11/01 05:11

mattuwan

総合スコア2163

syousuke.33

2020/11/02 05:13

投稿者のhana0118様からの反応がありませんが？？

mattuwan

2020/11/02 06:15

反応がないことを僕に聞かれても知りません。急病や、急な出張、諦め事情はいろいろあると思いますが、気をもんでもどうしようもないです。

hana0118

2020/11/02 11:53

ご回答ありがとうございます。お返事が遅くなってしまい申し訳ございません。教えて頂いたとおりに変更してみましたが、残念ながら違う値が表記されてしまいました。せっかくご回答いただいたのに申し訳ございません。

mattuwan

2020/11/03 03:32

それは残念です。こちらが何かを勘違いしているのでしょう。解決したなら、よかったです。

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

Sub E列の合計のみF列に移動1()
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  'ｊが "０"の場合新たに集計する
        Cells(i, 3).Select
        a = ActiveCell.Row  '行№確保（集計する行番地）
        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

End Sub

投稿2020/11/01 04:24

syousuke.33

総合スコア312