[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『塗りつぶしと塗りつぶしの個数』（安西先生マクロがしたいです）
2日続けて申し訳ありません。
サンプルコードを使いながら
B C D E F G H 1 302 524 287 306 1 2 157 210 185 210 2 3 85 100 130 125 118 1 4 450 300 420 350 400 1 5 130 150 250 180 210 1 6 350 400 360 400 380 2 7 200 180 160 175 1 8 240 3000 320 300 1 9 210 240 310 300 1 10 420 410 460 450 1 11 合計 2 2 3 2 2 1
このような表を100行以上作っています。
B〜Gの最大値をHに表示し、11行目に各列の塗りつぶしの行われているセルの個数を出しています。
塗りつぶしの合計数を表示するマクロは
Function ColorCount(R1 As Range, C As Range)
Dim r As Range
Application.Volatile
ColorCount = 0
For Each r In R1
If r.Interior.Color = C.Interior.Color Then
ColorCount = ColorCount + 1
End If
Next r
End Function を使用し、関数を=colorcount(B1:B11,A13)としてB列の塗りつぶしの数を出しました。 ※A13に同色の塗りつぶし
ここからが今回の本題になるのですが、
・各行指定範囲内の最高値に塗りつぶしを行う
・条件付き書式上位1位では関数が判定できなかった
・colorcount関数で塗りつぶしが判断できる
・関数が入った後に数字を入れても関数が情報を更新してくれる
といった事を行うにはどのようなマクロコードを作成すればいいのでしょうか？
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
（隠居じーさん） 2018/08/02(木) 18:22
（隠居じーさん） 2018/08/02(木) 18:29
もしかしたら、↓がヒントになりませんか？
[[20170715120206]]
『条件付き書式でセルに色を付けた時のカウント』（たかみ）
ただ、そんなめんどくさいことをしなくてもmax関数で最大値を求めて、countif関数でそれが範囲内にいくつあるのか数えれば、ユーザー定義関数使う必要なく対処できる気がします。
（もこな２） 2018/08/02(木) 20:35
（もこな２） 2018/08/02(木) 20:42
解決しなかったら他の掲示板に行っていいかの意味なら、好きにしてとしか…
(マルチポストは見てて、あんまり愉快ではないので、移動するならフェードアウトするんじゃなくて、その旨一言書いておくといいとおもいます。)
（もこな２） 2018/08/03(金) 18:43
＞ B C D E F G H ＞1 302 524 287 306 1 ＞2 157 210 185 210 2 ＞3 85 100 130 125 118 1
＞B〜Gの最大値をHに表示し
上の表のH列は、各行における最大値の数 下の説明は、各行の最大値そのもの
どっちが本当なんですか？
マクロを使わなくても、普通に数式で出来そうに思うんですけど 数式はダメなんですか？
（半平太） 2018/08/20(月) 15:21
=COUNTIF(B1:F1,MAX(B1:F1))
をオートフィル。
表内のチェンジイベントで
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long, j As Long, 塗潰合計(4) As Variant
With ThisWorkbook.Sheets("Sheet1")
If Target.Row < 11 And Target.Column > 1 And Target.Column < 7 Then
.Range("B1:F10").Interior.ColorIndex = 0
For i = 1 To 10
For j = 2 To 6
If .Cells(i, j) = WorksheetFunction.Max(.Range(.Cells(i, "B"), .Cells(i, "F"))) Then
.Cells(i, j).Interior.Color = 255
塗潰合計(j - 2) = 塗潰合計(j - 2) + 1
End If
Next j
Next i
.Range("B11:F11") = 塗潰合計
End If
End With
End Sub
で希望の動きをすると思います。
参考になれば幸いです。
（TAKA） 2018/08/20(月) 16:28
.Cells(i, j).Interior.Color = 255
で勝手に赤く塗りつぶしてますが、マクロ記録などで調べて好きな色にしてください
（TAKA） 2018/08/20(月) 16:32
85 100 130 125 1 450 300 420 350 1 130 150 250 180 210 1 350 400 360 400 2 200 180 160 175 1 240 3000 320 300 1 210 240 310 1 420 410 460 450 1 2 2 4 1 3
ちなみに実行結果です。
D11は4で、E11は1が正しいはずです。
(たぶんD8の3000が間違い？)
（TAKA） 2018/08/20(月) 16:37
＞最終行に塗りつぶされたセルの個数を出したい
結果としては、最大値の数と同じですよね？ (苦労して塗りつぶしセルを数えなくても、いいんじゃないですか？）
こんな対策ではダメですか？ ↓ (1) H1セル =COUNTIF(B1:G1,J1) (2) J1セル =MAX(B1:G1)
H1とJ1の数式を下までコピー
(3) B11セル =SUMPRODUCT((B1:B10=$J1:$J10)*1)
B11の数式をG11までコピー
<結果図> 行 __A__ _B_ _C_ __D__ _E_ _F_ _G_ _H_ _I_ __J__ 1 302 524 287 306 1 524 2 157 210 185 210 2 210 3 85 100 130 125 118 1 130 4 450 300 420 350 400 1 450 5 130 150 250 180 210 1 250 6 350 400 360 400 380 2 400 7 200 180 160 175 1 200 8 240 3000 320 300 1 3000 9 210 240 310 300 1 310 10 420 410 460 450 1 460 11 合計 2 2 4 1 2 1
（半平太） 2018/08/20(月) 16:39
Dim r As Range, c As Range, cc As Range
Set r = Selection
For Each c In r
For Each cc In Intersect(c.EntireRow, r)
If c.Value = WorksheetFunction.Max(Intersect(c.EntireRow, r)) Then
c.Interior.Color = RGB(0, 255, 0)
End If
Next cc
Next c
For Each c In r
If c.Interior.Color = RGB(0, 255, 0) Then
Intersect(c.EntireRow, r).Cells(1).Offset(, r.Columns.Count).Value = Val(Intersect(c.EntireRow, r).Cells(1).Offset(, r.Columns.Count).Value) + 1
Cells(r.Cells(1).Offset(r.Rows.Count).Row, c.Column).Value = Val(Cells(r.Cells(1).Offset(r.Rows.Count).Row, c.Column).Value) + 1
End If
Next c
End Sub
（mm） 2018/08/20(月) 17:45
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.