[VBA] 找出最大值並上色

Sub 找出最大值並上色()

'獲得矩陣大小

Dim n As Integer

n = Range("A1").End(xlDown).Row

MsgBox (" Total Row = " & n)

'將對角線以*符號替代

Dim x As Variant

Dim y As Variant

For x = 1 To n

Cells(x, x) = "*"

Next

''找尋每列中的最大值上黃色,最小值上紅色

Dim A As Variant

Dim MAX_V As Variant

Dim MIN_V As Variant

For y = 1 To n

A = Range(Cells(y, 1), Cells(y, n))

MAX_V = Application.WorksheetFunction.Max(A)

MIN_V = Application.WorksheetFunction.Min(A)

For x = 1 To n

If Cells(y, x) = MAX_V Then

Cells(y, x).Interior.ColorIndex = 6

Else

If Cells(y, x) = MIN_V Then

Cells(y, x).Interior.ColorIndex = 3

End If

End If

Next

Next

'將對角線*符號換回1

For x = 1 To n

Cells(x, x) = "1"

Next

End Sub