Sub 特定区域按颜色求和()
Dim Rngone As Range, Rng As Range, Rg As Range, RngSet As Range, RngColor As Range
Dim MsgR As VbMsgBoxResult
On Error Resume Next
Set RngSet = Selection
Set Rng = Application.InputBox("请指定待求和区域" & Chr(10) & "多个区域可用逗号,隔开", "区域", RngSet.Address, , , , , 8)
If Err.Number > 0 Then Exit Sub
linecolor:
Set RngSet = Selection
Set RngColor = Application.InputBox("请选择一个单元格:指定需要求和单元格的填充颜色" & Chr(10) & "求和时将忽略文本", "指定求和的颜色", RngSet.Address, , , , , 8)
If Err.Number > 0 Then Exit Sub
If RngColor.Count > 1 Then
MsgBox "请选择一个单元格以确定求和的颜色" & Chr(10) & "必须是单个且不能是合并单元格", , "提示"
GoTo linecolor
End If
For Each Rngone In Rng
If Rngone.Interior.Color > RngColor.Interior.Color Then GoTo line
If TypeName(Rngone.Value) = "Error" Then
If MsgBox("单元格" & Rngone.Address & "存在错误值" & Chr(10) & "选择确定将忽略错误值", vbOKCancel, "提示") = vbCancel Then
Exit Sub
Else
GoTo line
End If
End If
If Rg Is Nothing Then
Set Rg = Rngone
Else
Set Rg = Union(Rg, Rngone)
End If
line:
Next
If Rg Is Nothing Then
MsgBox "没有满足条件的单元格", , "提示"
Else
If MsgBox("是否通过单元格输出结果", vbYesNo, "提示") = vbYes Then
Set Rng = Application.InputBox("请指定存放输出结果的单元格", "提示", , , , , , 8)
Rng = Application.WorksheetFunction.Sum(Rg)
Else
MsgBox "结果为:" & Application.WorksheetFunction.Sum(Rg), , "计算结果"
End If
End If
End Sub
,
温馨提示:内容为网友见解,仅供参考