[已解决]如何用自定义代码取得颜色最大值最小值及平均值

wooikeat9128

请师父帮忙，谢谢

最佳答案

月排行榜 / 总排行榜

爱疯

2017-7-5 09:45

color9_2.rar (11.2 KB, 下载次数: 3)

2017-7-5 09:50 上传

点击文件名下载附件


Function GetColor(Area As Range, Rng As Range, Mode As Integer)
    Select Case Mode
    Case 1
        GetColor = getMax(Area, Rng)
    Case 2
        GetColor = getMin(Area, Rng)
    Case 3
        GetColor = getAve(Area, Rng)
    End Select
End Function

Function getMax(Area As Range, Rng As Range)
    Dim x, y
    y = Application.Min(Area)
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            If x > y Then y = x
        End If
    Next
    getMax = y
End Function

Function getMin(Area As Range, Rng As Range)
    Dim x, y
    y = Application.Max(Area)
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            If x < y Then y = x
        End If
    Next
    getMin = y
End Function

Function getAve(Area As Range, Rng As Range)
    Dim x, count, sum
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            count = count + 1
            sum = sum + x
        End If
    Next
    getAve = sum / count
End Function


没想到好办法

跳转到最佳答案楼层

爱疯

color9_2.rar (11.2 KB, 下载次数: 3)

2017-7-5 09:50 上传

点击文件名下载附件


Function GetColor(Area As Range, Rng As Range, Mode As Integer)
    Select Case Mode
    Case 1
        GetColor = getMax(Area, Rng)
    Case 2
        GetColor = getMin(Area, Rng)
    Case 3
        GetColor = getAve(Area, Rng)
    End Select
End Function

Function getMax(Area As Range, Rng As Range)
    Dim x, y
    y = Application.Min(Area)
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            If x > y Then y = x
        End If
    Next
    getMax = y
End Function

Function getMin(Area As Range, Rng As Range)
    Dim x, y
    y = Application.Max(Area)
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            If x < y Then y = x
        End If
    Next
    getMin = y
End Function

Function getAve(Area As Range, Rng As Range)
    Dim x, count, sum
    For Each x In Area
        If x.Interior.ColorIndex = Rng.Interior.ColorIndex Then
            count = count + 1
            sum = sum + x
        End If
    Next
    getAve = sum / count
End Function


没想到好办法

chart888

爱疯 发表于 2017-7-5 09:45
Function GetColor(Area As Range, Rng As Range, Mode As Integer)
    Select Case Mode
    C ...

爱疯老师写的代码
我都要琢磨好久

爱疯

chart888 发表于 2017-7-5 09:50
爱疯老师写的代码
我都要琢磨好久

这个你肯定一看就明白了，确实是没动脑筋的方式

苏子龙

1. Function SumC(Sum_range, ColorCell, Optional ColorId_Type = 0)
   
2.     Dim i%, arr, n%, Sm#
   
3.     C_Index = ColorCell.Interior.ColorIndex
   
4.     For i = 1 To Sum_range.Cells.Count
   
5.         If Sum_range.Cells(i).Interior.ColorIndex = C_Index Then
   
6.                 Sm = Sm + Sum_range.Cells(i) '求和
   
7.                 n = n + 1 '个数
   
8.            If ColorId_Type = 1 Then '最大
   
9.                 D_Sz = Sum_range.Cells(i)
   
10.                 If D_Sz > SumC Then SumC = D_Sz
    
11.             ElseIf ColorId_Type = 2 Then '最小
    
12.                 D_Sz = Sum_range.Cells(i)
    
13.                 If n = 1 Then SumC = D_Sz
    
14.                 If D_Sz < SumC Then SumC = D_Sz
    
15.             End If
    
16.         End If
    
17.     Next
    
18.     If ColorId_Type = 0 Then
    
19.          SumC = Sm '和
    
20.     ElseIf ColorId_Type = 3 Then
    
21.          SumC = Sm / n '平均
    
22.     ElseIf ColorId_Type = 4 Then
    
23.         SumC = n '个数
    
24.     End If
    
25. End Function
    

复制代码

写了些基本的，凑个数吧

wooikeat9128

苏子龙老師您真牛，一次解決所有問題