Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

44040 / 76735

←次へ　｜　前へ→


	【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】色付セルのみ集計 ＣＯＧ 06/5/15(月) 20:23