Microarray VBA 隨手寫用EXCEL 畫 heatmap

今天為了圖示了一些數據，寫了一小段VBA的CODE，用了一下覺得蠻好用的，貼上來給大家參考一下。
用這個巨集就可以用EXCEL 來做 Heatmap，當然你也可以修改IF 條件式，加上自己的顏色定義邏輯，甚至加上 Hierarchic cluster 的演算法.....，Anyway, 我覺得用EXCEL來劃 heatmap 簡單又好用。

Public Sub heatmap()
Dim R1, R2, C1, C2, i, j, cR, cG As Integer
Dim add As String
Dim rMax, rMin, rMid, rRange As Double

'訂最大值最小值設定色階
rMax = Application.WorksheetFunction.Max(Selection)
rMin = Application.WorksheetFunction.Min(Selection)
rMid = (rMax + rMin) / 2
rRange = Abs(rMax - rMin)

'取得Select range 範圍
add = Selection.Address(ReferenceStyle:=xlR1C1)
add = Replace(add, "R", "")
add = Replace(add, "C", ":")
s = Split(add, ":")
R1 = s(0)
R2 = s(2)
C1 = s(1)
C2 = s(3)

'Scan range 內值依色階給定顏色，不能讀的值設成藍色
For i = R1 To R2
    For j = C1 To C2
        cR = 0
        cG = 0
        On Error Resume Next
        If ActiveSheet.Cells(i, j).Value - rMid > 0 Then
            cR = ((ActiveSheet.Cells(i, j).Value - rMid) * 510) / rRange
        Else
            cG = ((rMid - ActiveSheet.Cells(i, j).Value) * 510) / rRange
       End if
        If Err = 0 Then ActiveSheet.Cells(i, j).Interior.Color = RGB(cR, cG, 0) Else ActiveSheet.Cells(i, j).Interior.Color = RGB(0, 0, 255)
    Next j
Next i

End Sub

##ReadMore##