Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7656 / 13644 ツリー ←次へ | 前へ→

【37694】色付セルのみ集計 COG 06/5/15(月) 20:23 質問[未読]
【37696】Re:色付セルのみ集計 Kein 06/5/15(月) 21:26 回答[未読]
【37699】Re:色付セルのみ集計 mori 06/5/15(月) 22:12 発言[未読]
【37700】Re:色付セルのみ集計 Kein 06/5/15(月) 22:21 発言[未読]
【37717】Re:色付セルのみ集計 COG 06/5/16(火) 15:59 お礼[未読]
【37716】Re:色付セルのみ集計 COG 06/5/16(火) 15:54 お礼[未読]
【37718】Re:色付セルのみ集計 Kein 06/5/16(火) 17:05 回答[未読]

【37694】色付セルのみ集計
質問  COG  - 06/5/15(月) 20:23 -

引用なし
パスワード
   初めまして、どなたかお教え下さい。
エクセルの表で色付のセルのみ集計をしたいのですがどのようにしたら良いのでしょうか?
下記の表でA1、B2、C2、C3 のみ色付セルの場合
AZ=A1、BZ=B2、CZ=C2+C3、DZ=0 となるようにしたのですが、
良い方法があれば教えて下さい。
マクロでは無く演算式での対応もあればお教え下さい。

    A  B  C  D
1   A1 B1 C1 D1
2   A2 B2 C2 D2
3   A3 B3 C3 D3

SUM AZ BZ CZ DZ

【37696】Re:色付セルのみ集計
回答  Kein  - 06/5/15(月) 21:26 -

引用なし
パスワード
   Ecel4マクロ関数を使う方法もありますが、ロジックが簡単な普通のやり方で

Sub MySUM()
  Dim ER As Long, EC As Long, Ret As Long
  Dim i As Long, j As Long
 
  ER = Range("A65536").End(xlUp).Row
  EC = Range("IV1").End(xlToLeft).Column
  For i = 1 To EC
   For j = 1 To ER
     If Cells(j, i).Interior.ColorIndex <> xlColorIndexNone Then
      Ret = Ret + Cells(j, i).Value
     End If
   Next j
   Cells(ER + 1, i).Value = Ret: Ret = 0
  Next i
End Sub

【37699】Re:色付セルのみ集計
発言  mori  - 06/5/15(月) 22:12 -

引用なし
パスワード
   If Cells(j, i).Interior.ColorIndex <> xlColorIndexNone Then

If Cells(j, i).Font.Color <> 0 Then
にすると良さそうです。

【37700】Re:色付セルのみ集計
発言  Kein  - 06/5/15(月) 22:21 -

引用なし
パスワード
   >色付のセル
と書いてあれば、普通それはセルの塗り潰しの色のことを指しますよね ?
フォントの色ならフォントの色と書くはずですが。

【37716】Re:色付セルのみ集計
お礼  COG  - 06/5/16(火) 15:54 -

引用なし
パスワード
   Kein さんへありがとうございます。
早速やってみます。

それと、Ecel4マクロ関数を使う方法もよろしければ
ご教授をお願いします。

【37717】Re:色付セルのみ集計
お礼  COG  - 06/5/16(火) 15:59 -

引用なし
パスワード
   ▼Kein さん:
>>色付のセル
>と書いてあれば、普通それはセルの塗り潰しの色のことを指しますよね ?
>フォントの色ならフォントの色と書くはずですが。

moriさん・Keinさんへご教授ありがとうございます。
私の書き方が不明瞭な点があり申し訳ありません。
私の場合はKeinさんの仰れるようにセルの塗り潰しの色のことを指します。
また、他にお気づきの点があればご教授をお願いします。

【37718】Re:色付セルのみ集計
回答  Kein  - 06/5/16(火) 17:05 -

引用なし
パスワード
   >Ecel4マクロ関数
すいません、タイプミスです。正しくは、もちろん "Excel4マクロ関数" です。
それを使うコードは、以下のようになります。

Sub Sum_ColorCells()
  Dim cR As Long, xR As Long, xC As Long
  Dim Ad1 As String, Ad2 As String, Ad3 As String
 
  With Range("A1").CurrentRegion
   cR = .Rows.Count
   xR = cR * 2 + 1
   xC = .Columns.Count
   Ad1 = .Columns(1).Address(, 0)
   With .Offset(cR)
     Ad2 = .Address
     Ad3 = .Columns(1).Address(, 0)
   End With
  End With
  Application.ScreenUpdating = False
  ThisWorkbook.Names.Add Name:="MyCol", _
  RefersToR1C1:="=GET.CELL(63,R[" & cR * -1 & "]C)+NOW()*0"
  Range(Ad2).FormulaR1C1 = "=MyCol"
  Cells(xR, 1).Resize(, xC).Formula = _
  "=SUMIF(" & Ad3 & ","">0""," & Ad1 & ")"
  With Range("A:A").SpecialCells(3).Resize(, xC)
   .Copy
   .PasteSpecial xlPasteValues
  End With
  Range(Ad2).EntireRow.Delete xlShiftUp
  Range("A1").Select
  ThisWorkbook.Names("MyCol").Delete
  With Application
   .CutCopyMode = False
   .ScreenUpdating = True
  End With
End Sub

7656 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free