エクセルの小計の計算について質問いたします。
A列 B列 C列 D列 E列 F列
1 施設名
2 商品名,内容 1 単位 単価 金額(数量×単価)
3 商品名,内容 1 単位 単価 金額(数量×単価)
4 小計 ●●●●
―――――――――――――――――――――――――――――――――
5 施設名
6 商品名,内容 1 単位 単価 金額(数量×単価)
7 商品名,内容 1 単位 単価 金額(数量×単価)
8 商品名,内容 1 単位 単価 金額(数量×単価)
9 小計 ●●●●
―――――――――――――――――――――――――――――――――
合計 ●●●●
施設名ごとに項目が複数あり、施設ごとに項目の数も違います。
これを施設ごとに●の所に小計を出したいです。
「小計」が数回にわたり出てくる場合は、「前回小計をした次のセルから今回小計するセルの前まで」を計算させる訳ですが、どんなVBAを組めばいいのかわかりません。
理想としてはにE列に小計という文字を入れるとF列に自動で計が出るようにして、さらに小計の合計を最後の行のセルにだしたいです。。
さらに、見やすくなるように小計の下のセルにA~Fの間に太線を引いて施設ごとの区切りがわかるようにしたいです。。
繰り返し作業ばかりで大変です。
どなたか知恵をお貸しください。
No.10ベストアンサー
- 回答日時:
続けてお邪魔します。
No.9の補足を読みました。
この際ですので、とことん付き合っちゃいます!
今までのコードはすべて無視してください。
結局、↓の画像でB・E(A列も含めて)変更があるたびにマクロを実行しなければならなくて、
なおかつ小計・合計の行に関しては数式で表示!
がご希望だというコトですので、もう一度考えてみました。
合計の場合は単にSUMIF関数で対応できますが、小計の行は数式でやる場合
配列数式を使う必要があると思います。
VBAで配列数式はおそらく拒否されると思います。
そこで一案です。
↓の画像のように作業用の列を2列設けます。
G1セルに
=IF(E2="小計",SUM(INDIRECT("F"&LARGE($H$1:$H1,2)&":F"&MAX($H$1:$H1))))
H1セルに
=IF(COUNTA(A2:E2),IF(E2="",ROW()+2,IF(OR(E2="",E2="小計"),ROW(),"")))
という数式を入れG1・H1セルを範囲指定 → H1セルのフィルハンドルでずぃ~~~!っと
これ以上データはないというくらい「これでもか!」っとオートフィルでコピーしておきます。
作業列が目障りであれば、オートフィル後にG・H列を非表示にしておきます。
そうした操作を行った上で、↓のコードをコピー&ペーストしてデータを入力してみてください。
データ配置は画像通りとします。
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long
If Application.Intersect(Target, Range("A:A,C:C,E:E")) Is Nothing Or Target.Count <> 1 Then Exit Sub
With Target
i = .Row
If .Column = 1 Then
Range(Cells(i, "E"), Cells(i, "F")).ClearContents
ElseIf .Column = 3 Or .Column = 5 Then
If IsNumeric(.Value) Then
Cells(i, "F") = Cells(i, "C") * Cells(i, "E")
Else
If IsNumeric(.Value) Then
.Offset(, 1) = .Offset(, -2) * Target
ElseIf .Value = "小計" Then
.Offset(, 1).ClearContents 'この行を追加
.Offset(, 1).Formula = .Offset(-1, 2).Formula '←G列の数式をそのまま引用
With Cells(i, 1).Resize(1, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
ElseIf .Value = "合計" Then
.Offset(, 1).Formula = "=SUMIF(E:E,""小計"",F:F)"
End If
End If
End If
End With
End Sub 'この行まで
この程度しか思いつきません。
お役に立ちますかね?m(_ _)m
この回答への補足
(T0T)ありがとうございます!!!
何回も何回も要望を聞いていただいてありがとうございます!!
先ほど新しいVBAを入れてみました(*^^*)
確かに!!
こんな方法があるんですね!!!
でも、なぜか小計の金額がどうしても合わないのです。。。
小計の金額がなぜかよくわからない合計になってしまうのです。。
なぜでしょうか。。。。
それと一つ聞きたいのですが、小計の出し方を、前のように数字で出すようにしたとして、もしその後に項目が変わり数量や単価の金額を訂正するようになった場合、自動的に小計の金額も変わるようにはできたりはしませんか???
ほんとに申し訳ありません。。。
御礼もしたいです。
超初心者ですみません。
何回も質問に答えてくれてありがとうございました。
何もわからないところから、何とか糸口が見えてきたのはかなりの進歩だと思います。
引き続きいろいろと対策を練っていきたいと思います。
本当にありがとうございました。
また何かの時は宜しくお願いいたします。
No.9
- 回答日時:
No.2・8です。
何度もごめんなさい。
前回のコードで不具合がありました。
↓のコードに変更してください。(配置は画像通りとします)
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, k As Long
If Application.Intersect(Target, Range("A:A,E:E")) Is Nothing Or Target.Count <> 1 Then Exit Sub
With Target
i = .Row
If .Column = 1 Then
Range(Cells(i, "E"), Cells(i, "F")).ClearContents
Else
If IsNumeric(.Value) Then
.Offset(, 1) = .Offset(, -2) * Target
ElseIf .Value = "小計" Then
k = i - 1
Do While Cells(k, "E") <> "" '←ココを修正
k = k - 1
Loop
.Offset(, 1) = WorksheetFunction.Sum(Range(Cells(k, "F"), Cells(i, "F")))
With Cells(i, 1).Resize(1, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
ElseIf .Value = "合計" Then
.Offset(, 1) = WorksheetFunction.SumIf(Range(Cells(2, "E"), Cells(i, "E")), "小計", _
Range(Cells(2, "F"), Cells(i, "F")))
End If
End If
End With
End Sub 'この行まで
※ 検証せずに投稿してごめんなさいね。m(_ _)m
この回答への補足
おはようございます。
何度も検証していただき、ご投稿ありがとうございました。
まさに、小計と入れた時に数字が出てきました。
ありがとうございます。
厚かましくも、またまたお願いなんですが、
>F列の単価の行に数字を入れると自動的にG列の金額の所に(数量D列×単価F列)が入るようにできますでしょうか???
↑この時や
小計、合計を入力するときなんですが、数字ではなくて計算式を入れて計算できますか?
例えば
tom04さんが明記してくれた画像の、
〇〇施設の小計を出すときにF6に合計した数字ではなくて
=SUM(F3:F5)を入れて数字を出したいです。
なぜかというと単価や数量が見積作成段階で何回か訂正されることがあるんです。。
あと、小計なんですが、〇〇施設(一番初めの小計)は問題なく計が出るのですが、△△施設(一番目以降の小計)は、〇〇施設の個別の金額+〇〇施設の小計の金額も足された金額がでてしまいます。
これはどのように解決すればよろしいでしょうか???
何回も何回もごめんなさい。
No.8
- 回答日時:
No.2です。
補足に
>合計はその都度でる感じではなくて合計と入れると、今までの小計が合計されて出るようにできますか??
>F列の単価の行に数字を入れると自動的にG列の金額の所に(数量D列×単価F列)が入るようにできますでしょうか???
と2点の件がありましたので・・・
最初の質問文と補足の列が違っているようなので、↓の画像の配置だとしてのコードです。
(1行目の配置が少し違うかと思いますが、普通は1行目が項目行になると思いますので、敢えて↓のような配置にしています。
前回のコードは無視して↓のコードに変更してみてください。
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, k As Long, c As Range
If Application.Intersect(Target, Range("A:A,E:E")) Is Nothing Or Target.Count <> 1 Then Exit Sub
With Target
i = .Row
If .Column = 1 Then
Range(Cells(i, "E"), Cells(i, "F")).ClearContents
Else
If IsNumeric(.Value) Then
.Offset(, 1) = .Offset(, -2) * Target
ElseIf .Value = "小計" Then
k = i - 1
Do While IsNumeric(Cells(k, "E"))
k = k - 1
Loop
.Offset(, 1) = WorksheetFunction.Sum(Range(Cells(k, "F"), Cells(i, "F")))
With Cells(i, 1).Resize(1, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
ElseIf .Value = "合計" Then
.Offset(, 1) = WorksheetFunction.SumIf(Range(Cells(2, "E"), Cells(i, "E")), "小計", _
Range(Cells(2, "F"), Cells(i, "F")))
End If
End If
End With
End Sub 'この行まで
※ 余計なお世話かもしれませんが、A列に「施設名」を入力すると、その行の「合計」と「合計金額」は
消すようにしてみました。
※ 今回もデータは画像でいえば2行目から入力するとしています。
こんな感じではどうでしょうか?m(_ _)m
No.7
- 回答日時:
'データシートをアクティブにして実行する
'データは明細だけで合計行は自動作成(事前の加工は無用!)
'別データシートに編集更新版(何回でもやり直し可能)
'環境依存部分はConstを変更する
Option Explicit
Sub Breaks()
Const xName_To = "Summary"
Const xKey_Col = 1
Const xSum_Col = 6
Const xHeads = 1
Const xSepa = "="
Dim xSheet As Worksheet
Dim xName_From As String
Dim xBorder As String
Dim xSum As Long
Dim xSum_Small As Long
Dim xChk_Row As Long
Dim xLast_From As Long
Dim xLast_To As Long
Dim kk As Long
Dim mm As Long
Dim nn As Long
Dim xNoData As Boolean
Application.ScreenUpdating = False
xName_From = ActiveSheet.Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(xName_To).Delete
xNoData = True
For Each xSheet In Worksheets
'If (xSheet.Name = xName_To) Then
'xSheet.Delete
'Exit For
'Else
xLast_From = xSheet.Cells(Rows.Count, xSum_Col).End(xlUp).Row
'有効データがあるか確認
If (xLast_From > xHeads) Then
xNoData = False
End If
'End If
Next
If Not (xNoData) Then
Set xSheet = Worksheets(xName_From)
xBorder = "'" & String(80, xSepa)
'最後尾に集計用のワークシートを追加
kk = Worksheets.Count
Worksheets.Add After:=Worksheets(Worksheets.Count)
If (Worksheets.Count > kk) Then
Worksheets(Worksheets.Count).Name = xName_To
Else
Exit Sub
End If
With Worksheets(xName_To)
xLast_From = xSheet.Cells(Rows.Count, xSum_Col).End(xlUp).Row
If (xLast_From > xHeads) Then
'見出しをコピー
xSheet.Rows(1 & ":" & xHeads).Copy
.Rows(1).PasteSpecial
xLast_From = xLast_From + 1
'最終行にBreak Key(クローザ)をセットアップ
xSheet.Cells(xLast_From, xKey_Col).Value = "合計"
xSheet.Cells(xLast_From, xSum_Col).Offset(0, -1).Value = "合計"
xSum = 0
xChk_Row = xHeads + 1
mm = xHeads + 1
For nn = (xHeads + 1) To xLast_From
'Break Key(集計単位の先頭位置:xKey_Colが空白ではない)を確認
If Not IsEmpty(xSheet.Cells(nn, xKey_Col).Value) Then
If (nn > xChk_Row) Then
xSum_Small = 0
'明細行を集計
For kk = (xChk_Row + 1) To (nn - 1)
xSum_Small = xSum_Small + xSheet.Cells(kk, xSum_Col).Value
Next
Application.CutCopyMode = False
'集計単位をまとめてコピー
xSheet.Rows(xChk_Row & ":" & nn - 1).Copy
.Rows(mm).PasteSpecial xlPasteValues
mm = mm + (nn - xChk_Row)
.Rows(mm).Resize(2).Insert
.Cells(mm, "A").Value = xBorder
.Cells(mm, xSum_Col).Offset(1, -1).Value = "小合計"
.Cells(mm, xSum_Col).Offset(1, 0).Value = xSum_Small
mm = mm + 2
xSum = xSum + xSum_Small
xChk_Row = nn
End If
Else
'明細行(xKey_Colが空白)
'不要?個別金額計算(C列:数量、E列:@)
xSheet.Cells(nn, xSum_Col).Value = xSheet.Cells(nn, "C").Value * xSheet.Cells(nn, "E").Value
End If
Next
xLast_To = .Cells(Rows.Count, xSum_Col).End(xlUp).Row
.Cells(xLast_To + 1, "A").Value = xBorder
.Cells(xLast_To + 2, xSum_Col).Offset(0, -1).Value = "合計"
.Cells(xLast_To + 2, xSum_Col).Value = xSum
End If
End With
Else
MsgBox ("No Data Found!!")
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
この回答への補足
回答ありがとうございました。
凄いですね(^0^)
別シートですが、綺麗に計算されていました。
ただ、やはり同一シートで小計を出したいのでなかなか難しいですね~。
わざわざ時間を割いて作成ありがとうございます。
また次のステップに考えていきたいと思います。
No.6
- 回答日時:
'データシートをアクティブにして実行する
'データは明細だけ
'合計は施設名の行
'セパレータなし
'データシート直接更新版(やり直しの場合に問題あり)
Option Explicit
Sub Breaks()
Const xKey_Col = 1
Const xSum_Col = 6
Const xHeads = 1
Const xSepa = "="
Dim xSheet As Worksheet
Dim xBorder As String
Dim xSum As Long
Dim xSum_Small As Long
Dim xChk_Row As Long
Dim xLast As Long
Dim kk As Long
Dim mm As Long
Dim nn As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBorder = "'" & String(80, xSepa)
Set xSheet = ActiveSheet
xLast = Cells(Rows.Count, xSum_Col).End(xlUp).Row
If (xLast > xHeads) Then
xLast = xLast + 1
Cells(xLast, xKey_Col).Value = "合計"
Cells(xLast, xSum_Col).Offset(, -1).Value = "合計"
xSum = 0
xChk_Row = xHeads + 1
For nn = (xHeads + 1) To xLast
If Not IsEmpty(Cells(nn, xKey_Col).Value) Then
If (nn > xChk_Row) Then
xSum_Small = 0
For mm = (xChk_Row + 1) To (nn - 1)
xSum_Small = xSum_Small + Cells(mm, xSum_Col).Value
Next
Cells(xChk_Row, xSum_Col).Offset(, -1).Value = "小合計"
Cells(xChk_Row, xSum_Col).Value = xSum_Small
xSum = xSum + xSum_Small
xChk_Row = nn
End If
Else
Cells(nn, xSum_Col).Value = Cells(nn, "C").Value * Cells(nn, "E").Value
End If
Next
Cells(xLast, xKey_Col).Value = ""
Cells(xLast, xSum_Col).Value = xSum
Rows(xLast).Insert
Cells(xLast, "A").Value = xBorder
Else
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
No.5
- 回答日時:
中太罫線も引くんでしたね。
バックアップを取ってから試してください小計や合計はピボットテーブルで別表にするほうが良いと思いますが、勉強がてら作ってみました
Sub 駄作でも動くはず2()
'変数定義
Dim u As Long, v As Long, w As Long, i As Long
'最終行u
u = Cells(Rows.Count, 5).End(xlUp).Row
'「小計」の数v
Cells(u, 6).FormulaR1C1 = "=COUNTIF(C5,""小計"")"
v = Cells(u, 6).Value
'E列選んで
Columns("E:E").Select
'Ctrl+F 小計を検索
Selection.Find(What:="小計", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
'アクティブセルの行w
w = ActiveCell.Row
'その行のF列に 数式を入れる
Cells(w, 6).Formula = "=subtotal(9,F2:F" & w - 1 & ")"
With Range("a" & w & ":f" & w).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
'小計の個数v -1回繰り返し
For i = 2 To v
'次の小計を検索
Selection.FindNext(After:=ActiveCell).Activate
'その行のF列に 数式を入れる
Cells(ActiveCell.Row, 6).Formula = "=subtotal(9,F" & w + 1 & ":F" & ActiveCell.Row - 1 & ")"
'アクティブセルの行w
w = ActiveCell.Row
With Range("a" & w & ":f" & w).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Next i
'合計に 数式を入れる
Cells(u, 6).Formula = "=Subtotal(9,F2:F" & u - 1 & ")"
'セル選択
Cells(u, 6).Select
End Sub
この回答への補足
早速の回答ありがとうございました。
ですが、'Ctrl+F 小計を検索
Selection.Find(What:="小計", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
この行でエラーになってしまいます(t0t)
No.4
- 回答日時:
Sub 駄作でも動くはず()
'変数定義
Dim u As Long, v As Long, w As Long, i As Long
'最終行u
u = Cells(Rows.Count, 5).End(xlUp).Row
'「小計」の数v
Cells(u, 6).FormulaR1C1 = "=COUNTIF(C5,""小計"")"
v = Cells(u, 6).Value
'E列選んで
Columns("E:E").Select
'Ctrl+F 小計を検索
Selection.Find(What:="小計", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, MatchByte:=False, SearchFormat:=False).Activate
'アクティブセルの行w
w = ActiveCell.Row
'その行のF列に 数式を入れる
Cells(w, 6).Formula = "=subtotal(9,F2:F" & w - 1 & ")"
'小計の個数v -1回繰り返し
For i = 2 To v
'次の小計を検索
Selection.FindNext(After:=ActiveCell).Activate
'その行のF列に 数式を入れる
Cells(ActiveCell.Row, 6).Formula = "=subtotal(9,F" & w + 1 & ":F" & ActiveCell.Row - 1 & ")"
w = ActiveCell.Row
Next i
'合計に 数式を入れる
Cells(u, 6).Formula = "=SUbtotal(9,F2:F" & u - 1 & ")"
'セル選択
Cells(u, 6).Select
End Sub
No.3
- 回答日時:
こんにちは。
表計算やデータベースでの一般的なテーブルとしての要件を満たしていれば、
Excelの一般機能([データ]タブにある)[小計](SUBTOTAL)を使うことが出来て、、
一々"小計"と入力する手間なしで、ご質問の要求はほぼ達成できます。
足りないのは、小計・合計の対象となる行のA列を省略してしまっていること。
または、各データ(レコード)がどの施設の物かを示す一意のキーがないこと。
誤って並べ替えてしまったりした時にデータ修復を容易にする意味でも
テーブルのレコードには、各行ごとに、それが何のデータなのかを示すデータ
が、あった方が、色々な意味で融通が利くものです。
(その方が回答も付き易いでしょう。)
見易さを意図したA列の表記はそれはよく見かけるやり方ですが、
普通はA列とB列の間位に施設を示すキー(名前かID)項目を置くものです。
フォーマットを(絶対的に)変えられない状況なら仕方ありませんが、
何よりもまず、現在のフォーマットを変えることを検討した方がよいとは思います。
日常的な作業が大変だというのは、日常的な作業を簡潔にする為の準備で解決する
のが正攻法で、後付けのVBAでやりくりするのは、ちょっと気が進まないのですが、
さておき。
オーダー通りにVBAを組んでみるとして、
せっかくVBAでやるのに手入力を契機にするのも違和感があるので、
E列かF列の空セルをダブルクリックしたら機能するように書いてみます。
また、「前回小計をした次のセルから」より簡単にする為、
対象の行より上で一番近い行にある施設名の行の一つ下の行から、
と解釈換えをします。
' ' =====シートモジュール===== ' ' Re8017328
' ' E列F列をダブルクリックした時、E列F列共に空セルなら実行
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim nTop As Long, nBtm As Long
' ' E列F列以外なら抜ける。
If Target.Column < 5 Or Target.Column > 6 Then Exit Sub
' ' 設定したいセルが入力済なら抜ける。
If Application.CountA(Target.EntireRow.Columns("E:F")) Then Exit Sub
' ' ダブルクリックした行を基準に
With Target.EntireRow
' ' 小計する先頭行を求める。
nTop = .Cells(1).End(xlUp).Row
' ' 小計する末尾行を求める。
nBtm = .Row - 1
' ' 小計タイトルと小計をセルに設定する。
.Columns("E:F").Value = Array("小計", Application.Sum(Range("F" & nTop & ":F" & nBtm)))
' ' 罫線。
With .Resize(, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End With
' ' 合計を設定する行位置を求める。
nBtm = Cells(Rows.Count, "F").End(xlUp).Row + 1
' ' 合計タイトルと合計をセルに設定する
Range("E" & nBtm & ":F" & nBtm).Value = Array("合計", Application.SumIf(Range("E2:E" & nBtm - 1), "小計", Range("F2:F" & nBtm - 1)))
' ' ダブルクリックによりセルが編集状態になるのをCancelする。
Cancel = True
End Sub
' ' ==========================
同一のブック内に同じ内容の作業をするシートが複数ある場合は
Thisworkbookモジュールに以下を貼り付けます。
編集したくないシートがある場合は予めそのシートの名前を指定して置きます。
' ' =====Thisworkbookモジュール===== ' ' Re8017328
' ' E列F列をダブルクリックした時、E列F列共に空セルなら実行
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim nTop As Long, nBtm As Long
' ' 編集したくないシートをダブルクリックした場合なら抜ける。
If Sh.Name = "シート名" Then Exit Sub ' "シート名" 要指定
' ' E列F列以外なら抜ける。
If Target.Column < 5 Or Target.Column > 6 Then Exit Sub
' ' 設定したいセルが入力済なら抜ける。
If Application.CountA(Target.EntireRow.Columns("E:F")) Then Exit Sub
' ' ダブルクリックした行を基準に
With Target.EntireRow
' ' 小計する先頭行を求める。
nTop = .Cells(1).End(xlUp).Row
' ' 小計する末尾行を求める。
nBtm = .Row - 1
' ' 小計タイトルと小計をセルに設定する。
.Columns("E:F").Value = Array("小計", Application.Sum(Range("F" & nTop & ":F" & nBtm)))
' ' 罫線。
With .Resize(, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
End With
End With
' ' 合計を設定する行位置を求める。
nBtm = Cells(Rows.Count, "F").End(xlUp).Row + 1
' ' 合計タイトルと合計をセルに設定する
Range("E" & nBtm & ":F" & nBtm).Value = Array("合計", Application.SumIf(Range("E2:E" & nBtm - 1), "小計", Range("F2:F" & nBtm - 1)))
' ' ダブルクリックによりセルが編集状態になるのをCancelする。
Cancel = True
End Sub
' ' ==========================
※注
「D列E列共に空セル」の行で「D列またはE列をダブルクリック」で起動します。
とりあえず、以上です。
No.2
- 回答日時:
こんにちは!
F列の数式には手を付けなくてよい訳ですよね?
単にE列に「小計」と入力されたら、F列の小計・合計を表示するようにしてみました。
画面左下の操作したいSheet見出し上で右クリック → コードの表示 → VBE画面に
↓のコードをコピー&ペーストしてみてください。
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, k As Long, c As Range
If Application.Intersect(Target, Range("E:E")) Is Nothing Or Target.Count <> 1 Then Exit Sub
If Target = "小計" Then
Set c = Range("E:E").Find(what:="合計", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Resize(1, 2).ClearContents
End If
i = Target.Row
k = i - 1
Do While Cells(k, "B") <> ""
k = k - 1
Loop
Target.Offset(, 1) = WorksheetFunction.Sum(Range(Cells(k, "F"), Cells(i, "F")))
With Cells(i, 1).Resize(1, 6).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
With Target
.Offset(1) = "合計"
.Offset(1, 1) = WorksheetFunction.SumIf(Range(Cells(1, "E"), Cells(i, "E")), "小計", _
Range(Cells(1, "F"), Cells(i, "F")))
End With
End If
End Sub 'この行まで
※ データは必ず上の行から入力 → E列に「小計」と入力するとします。
※ すでに表示されているE列の「合計」F列の「合計額」はそのまま残しておいても
最後の行だけに「合計」を表示するようにしてみました。
こんな感じではどうでしょうか?m(_ _)m
この回答への補足
回答ありがとうございました。すごいです!!きちんと計算できました。
私の説明が悪くて申し訳ないのですが、
合計はその都度でる感じではなくて合計と入れると、今までの小計が合計されて出るようにできますか??
あと、F列の単価の行に数字を入れると自動的にG列の金額の所に(数量D列×単価F列)が入るようにできますでしょうか???
あつかましく聞いてしまってごめんなさい。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
「これはヤバかったな」という遅刻エピソード
寝坊だったり、不測の事態だったり、いずれにしても遅刻の思い出はいつ思い出しても冷や汗をかいてしまいますよね。特にものすごく怒られたときとか、とんでもない損害を与えてしまったときとか…。
-
任意のセルに小計、合計と入力したら自動計算してくれ
Excel(エクセル)
-
Excelでセルに「小計」と入力したら自動に計算してくれる関数
Excel(エクセル)
-
エクセルでページ毎の小計から最終ページで合計を出したい。
Access(アクセス)
-
-
4
値が入っているときだけ計算結果が表示されるようにするには・・?
Excel(エクセル)
-
5
EXCELでセルに小計と入力したら自動で計算してくれる
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・「I love you」 をかっこよく翻訳してみてください
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・昔のあなたへのアドバイス
- ・かっこよく答えてください!!
- ・あなたが好きな本屋さんを教えてください
- ・スタッフと宿泊客が全員斜め上を行くホテルのレビュー
- ・【大喜利】【投稿~8/27】 こんなガソリンスタンド二度と来るか!なぜそう思った?
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・【お題】動物のキャッチフレーズ
- ・【お題】甲子園での思い出の残し方
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・「それ、メッセージ花火でわざわざ伝えること?」
- ・自分用のお土産
- ・人生で一番お金がなかったとき
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・ちょっと先の未来クイズ第1問
- ・ゴリラ向け動画サイト「ウホウホ動画」にありがちなこと
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【マクロ】functionプロシージ...
-
Excelの警告について
-
Excelシートに画像を貼る時
-
googleのスプレッドシート
-
エクセル IF計算式?でしょうか?
-
【マクロ】for nest について ...
-
エクセル折れ線グラフについて...
-
EXCELで数値が異なった数字を足...
-
Excelで数値を時間数に変換する...
-
Excelについて
-
エクセルでファイルの最終更新...
-
エクセルを使用して、円周率を...
-
エクセルの数式バーのフォント...
-
【マクロ】VLOOKUPにて参照元に...
-
Excel 対象のセルに入力が無い...
-
エクセルでセルに標準で入力さ...
-
EXCELの散布図で日付が1900年に...
-
Excelで表を作ったところに文字...
-
【マクロ】名前を保存する際に...
-
Excelについて。Excelに縦1列に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルの数式バーのフォント...
-
エクセルでファイルの最終更新...
-
2列に入っているデータを1列...
-
データチェックを行うエクセル...
-
再質問です。マクロの修正箇所...
-
エクセルで 自動的に◯や数字を...
-
数字入力後他の文字等が表示さ...
-
Excel 小さくなったスクロール...
-
F9キーについて。
-
【ExcelVBA】ダブルクォーテー...
-
Excelに詳しい方! B列が「日...
-
セルの数を求めたい
-
Excelを無料で使うには? パソ...
-
IFとIFS関数
-
【Excel】別シートから条件に合...
-
EXCELの散布図で日付が1900年に...
-
ある表にフィルターをかけて出...
-
【ExcelVBA】名前を付けて保存→...
-
Excelセルを跨いで合計を出す方法
-
エクセルのツールバーから数値...
おすすめ情報