エクセルの集計方法

質問

仕事で、物件内容と請求金額をエクセルで記入し、H列の請求金額に、集金済になると赤色に塗るような運用をしています。どこかのセルに、赤色(集金済合計)と塗りつぶしなし（未収金合計）を表示させたいのですが、可能でしょうか？

回答No.2

kagakusuki · ベストアンサー

御質問文に書かれている内容だけでは質問者様がマクロを使う事が出来るのかどうか判りませんでしたし、Excelを使っている方にもマクロはさっぱり解らないという方も少なくありませんでしたので、回答No.1ではマクロを使わずに済む方法をお伝え致した次第なのですが、マクロを使っても良いという事であれば他にも方法は御座います。
　それで、塗りつぶしの際には必ずボタンに登録したマクロを使用するという事であれば、そのマクロを次の様に変更する事で、御質問の件を解決出来るかと思います。

Sub ボタン1_Clic()

Const AlreadyCell As String = "J1" '集金済の合計額を表示させるセルのセル番号(J1は仮の値)
Const NotYetCell As String = "J2" '未集金の合計額を表示させるセルのセル番号(J2は仮の値)
Const BillingColumn As String = "H" '請求金額が入力されている列の列番号
Const FirstRow As Long = 2 '請求金額が入力されている最初の行の行番号(2は仮の値)
Dim LastRow As Long, c As Range, AlreadyMoney As Double, NotYetMoney As Double

With ActiveSheet
With .Shapes(Application.Caller)
Set c = ActiveSheet.Cells(.TopLeftCell.Row, "F").Resize(1, 6)
If .DrawingObject.Caption = "済" Then
c.Interior.ColorIndex = xlNone
.DrawingObject.Caption = "未"
Else
c.Interior.Color = vbRed
.DrawingObject.Caption = "済"
End If
End With
LastRow = .Range(BillingColumn & .Rows.Count).End(xlUp).Row
If LastRow < FirstRow Then LastRow = FirstRow
For Each c In .Range(BillingColumn & FirstRow & ":" & BillingColumn & LastRow)
If TypeName(c.Value) = "Double" Then
If c.Interior.Color = vbRed Then
AlreadyMoney = AlreadyMoney + c.Value
Else
NotYetMoney = NotYetMoney + c.Value
End If
End If
Next c
.Range(AlreadyCell).Value = AlreadyMoney
.Range(NotYetCell).Value = NotYetMoney
End With

End Sub

お礼

全く発想が違ってました。色のついたセルをどうするか・・・
ばかり考えてました。私は。まだまだですね。ご教授ありがとうございました。

回答No.3

Prome_Lin

ボタンを作成できるのでしたら、以下のマクロを質問者の環境に合わせて利用できないでしょうか？

新たにボタンを作成して、以下のマクロを関連付けてください。

Sub Test()
r1 = 0
r2 = 0
For i = 1 To Cells(Rows.Count, 8).End(xlUp).Row
If Cells(i, 8).Interior.ColorIndex > 0 Then
r1 = r1 + 1
Cells(r1, 2).Value = Cells(i, 8).Value
Else
r2 = r2 + 1
Cells(r2, 3).Value = Cells(i, 8).Value
End If
Next i
End Sub

簡単な説明です。

r1 = 0
r2 = 0

「r1」は、色がついていた場合の行数カウント用、「r2」は、色がついていない方の行数カウント用。

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

１行目から、列「H」の最終行まで処理。

If Cells(i, 8).Interior.ColorIndex > 0 Then

もし、「i」行目の列「H」のセルに色が付いていたら、

r1 = r1 + 1

色つき用カウントを＋１

Cells(r1, 2).Value = Cells(i, 1).Value

別のセルにその値を記入（質問者の環境に合わせてください）。

Else

それ以外（色がついていない）場合、

r2 = r2 + 1

色無し用カウント＋１。

Cells(r2, 3).Value = Cells(i, 1).Value

先ほどの隣のセルに記入（質問者の環境に合わせてください）。

お礼

全く発想が違ってました。色のついたセルをどうするか・・・
ばかり考えてました。私は。まだまだですね。ご教授ありがとうございました。

回答No.1

kagakusuki

集金済みの場合はどこかの列に「集金済」とか「済」などの様に集金済みである事を区別する事が出来る様な値を入力しておく様にする事は可能ですか?
　もし可能である場合にはSUMIF関数を使って御質問の件を実現する事が可能となります。
　例えば仮の話として、集金済みの場合にはI列のセルに「集金済」と入力しておく様にするものとします。
　その場合、集金済合計額を表示させるセルに入力する関数は次の様なものとなります。

=SUMIF($I:$I,"集金済",$H:$H)

　同じく、未収金合計額を表示させるセルに入力する関数は次の様なものとなります。

=SUMIF($I:$I,"<>集金済",$H:$H)

　また、集金済みの場合にはJ列のセルに「済」と入力しておく様にした場合には、集金済合計額を表示させる関数は、

=SUMIF($J:$J,"済",$H:$H)

になりますし、未収金合計額を表示させる関数は、

=SUMIF($J:$J,"<>済",$H:$H)

になります。

　因みに、上記の様にはどこかの列に集金済みである事を区別する事が出来る様な値を入力しておく様にした場合には、Excelの条件付き書式という機能を使用する事で

>集金済になると赤色に塗る

という事を自動的に行う事が出来る様になります。
　例えば、請求金額の入力欄がH3:H999のセル範囲のセルとなっていて(H2セルは「請求金額」などの様な項目名が入力されていて、表の罫線が引かれているのが2行目～999行目の行範囲となっている場合)、集金済みの場合にはI列のセルに「集金済」と入力しておく様にした場合には、以下の様な操作を行って条件付き書式を設定しておく事で、集金済になるとH列の請求金額欄が自動的に赤色で塗りつぶされる様にする事が出来ます。

H3セルを選択
　　↓
Excelウィンドウの[ホーム]タブをクリック
　　↓
現れた「スタイル」グループの中にある[条件付き書式]ボタンをクリック
　　↓
現れた選択肢の中にある[ルールの管理]をクリック
　　↓
現れた「条件付き書式ルールの管理」ダイアログボックスの中にある[新規ルール]ボタンをクリック
　　↓
現れた「新しい書式ルール」ダイアログボックスの「ルールの種類を選択して下さい」欄の中にある[数式を使用して、書式設定するセルを決定]をクリック
　　↓
現れた「次の数式を満たす場合に値を書式設定」欄の中に

=$I3="集金済"

と入力
　　↓
「新しい書式ルール」ダイアログボックスの[書式]ボタンをクリック
　　↓
現れた「セルの書式設定」ダイアログボックスの[塗りつぶし]タブをクリック
　　↓
現れた背景色のサンプルの中にある赤色の四角形をクリック
　　↓
「セルの書式設定」ダイアログボックスの[OK]ボタンをクリック
　　↓
「新しい書式ルール」ダイアログボックスの[OK]ボタンをクリック
　　↓
「条件付き書式ルールの管理」ダイアログボックスの「適用先」欄に入力されているセル範囲の設定を

$H$3:$H$999

に変更（カーソルとマウスの左ボタンによる範囲選択が使えます）
　　↓
「条件付き書式ルールの管理」ダイアログボックスの[適用]ボタンをクリック
　　↓
「条件付き書式ルールの管理」ダイアログボックスの[OK]ボタンをクリック

補足

すみません、区別する事が出来る様な値を入力するのは不可能です。
エクセルの操作すらままならない方も使用してますので、赤色に塗る作業すら、ボタンを押して赤に塗りつぶすようマクロをくんでます。

Sub ボタン1_Clic()
With ActiveSheet.Shapes(Application.Caller)
If .DrawingObject.Caption = "済" Then
.TopLeftCell.Offset(0, -6).Resize(1, 6).Interior.ColorIndex = xlNone
.DrawingObject.Caption = "未"
Else
Cells(.TopLeftCell.Row, "F").Resize(1, 6).Interior.Color = vbRed
.DrawingObject.Caption = "済"
End If
End With
End Sub