将单元格值与每一列的平均值进行比较

Question

我正在尝试在vba中为excel准备代码。每个月都有一个值列表，每个月在单独的列中列出，每个月下面列出多个值。

我想做的是更改每个单元格的颜色，该值比该月的平均值小4倍。到目前为止，我的代码看起来像这样，每个平均值的计算方式都与我想要的一样，但是我似乎无法弄清楚如何使它仅将单元格与一列的平均值进行比较，而不是与连续的所有单元格进行比较-就像这样做现在。

Sub MonthAverage()
    Dim Data As Variant
    Set Data = Selection
    Dim rows As Integer
    Dim columns As Integer

    rows = Data.rows.Count
    columns = Data.columns.Count

    Dim average As Double

    For j = 1 To columns
        average = 0#

        For i = 1 To rows
            average = average + Data.Cells(i, j)
        Next

        average = average / rows

        For Each cell In Data.Cells
            If cell.Value <= average / 4 Then cell.Interior.Color = RGB(0, 0, 255)
        Next

        MsgBox average 'just to make sure I got the averages correctly
    Next
End Sub

Answer 1

我已修改您的代码以在ActiveSheet而不是当前的Selection上工作。此代码循环遍历ActiveSheet中的每一列，并格式化每个单元格的颜色，该颜色小于平均值的四倍。

Sub MonthAverageV2()
    Dim ws As Worksheet
    Dim ThresholdVal As Double
    Dim i As Integer
    Dim j As Integer
    Dim r As Integer

    Set ws = ActiveSheet

    'Loop columns
    For i = 1 To ws.Cells(1, ws.columns.Count).End(xlToLeft).Column
        r = ws.Cells(ws.rows.Count, i).End(xlUp).Row
        'Column average
        ThresholdVal = Application.WorksheetFunction.average(ws.Range(ws.Cells(2, i).Address & ":" & ws.Cells(r, i).Address)) * 0.25
        Debug.Print ThresholdVal
        'Loop rows
        For j = 2 To r
            If ws.Cells(j, i).Value < ThresholdVal Then
                ws.Cells(j, i).Interior.Color = RGB(0, 0, 255)
            End If
        Next j
    Next i
End Sub

此外，我利用Application.WorksheetFunction.average计算每列的平均值。

Answer 2

此主题确实很有帮助，是新来的，在该主题上有点晚了，但是我遇到了一个要求非常相似的问题，尽管目标不是在一则规则中突出显示高于平均值的单元格-高于平均值的80％而其他颜色则高于平均水平50％，但要设置不同的图标。

这完全改变了整个图片，因为您无法定义在If / then语句中使用哪个图标，因此您不得不定义一种条件格式，因为我正在使用Analysis for Office插件和列范围是可变的。

任何帮助将不胜感激！干杯：）