Excel VBA質問箱 IV

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

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


44037 / 76732 ←次へ | 前へ→

【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

0 hits

【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 回答

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