前提・実現したいこと
VBAのマクロを使用して、表の範囲の中の最大値と最小値のセルに色を付けたいと考えています。
この表は、HLOOKUP関数で別シートからデータを取ってきていると仮定。
||1月|2月|3月|4月|5月|6月|7月|8月|9月|10月|11月|12月|
|:--|:--:|--:|
|2019|542|543|532|516|491|491|529|498|504|496|493|495|
|2020|490|487|427|351|264|339|402|377|391|402|431|351|
|2021|306|298|331|323|346|310|
マクロを実行すると、最大値(例の場合は2019年の2月)と最小値(例の2021年1月)のセルに色が付くというものです。
発生している問題・エラーメッセージ
最大値のセルに色を付けることは出来たのですが、最小値だと空白のセル(この場合2021年7月~12月)に色が塗られてしまう状態です。
該当のソースコード
Sub paintMaxAndMin() Dim ansmax As Variant Dim ansmin As Variant Dim tRange As Range Dim actRow As Long Dim actCol As Long actRow = ActiveCell.Row actCol = ActiveCell.Column Set tRange = Range(Cells(actRow, actCol), Cells(actRow, actCol).Offset(2, 11)) tRange.Interior.ColorIndex = xlColorIndexNone '値を検索 ansmax = Application.WorksheetFunction.Max(tRange) ansmin = Application.WorksheetFunction.Min(tRange) 'ここで値が0で返ってきてしまう Dim iRow As Integer Dim iCol As Integer Dim tmp As Variant 'ループを回して、最大値と最小値を持つセルを検索。該当のセルに背景色を塗る。 For iRow = 0 To 2 For iCol = 0 To 11 tmp = Cells(actRow + iRow, actCol + iCol).Value If tmp = ansmax Then Cells(actRow + iRow, actCol + iCol).Interior.ColorIndex = 38 End If If tmp = ansmin Then Cells(actRow + iRow, actCol + iCol).Interior.ColorIndex = 3 End If Next Next End Sub
回答2件
あなたの回答
tips
プレビュー