如何保持连续的最大值并删除其余的值？

Question

我正在努力处理枯燥的工作任务，要求我连续找到最高值并删除其余部分。

有问题的表格：

对于显示的表格，我希望找到产品的最高市场份额，并仅保留此值。我已经尝试过多次使用WorksheetFunction.Max，但该函数只找到一个最高值。在表格第1行中，我们可以看到产品有两个相等的最大值。我想保留他们两个并删除其他人。

任何帮助表示赞赏。谢谢你的时间！ ：）

编辑：

这是我设法做的代码：

Sub products()    

Dim row As Integer
Dim highest As Double
Dim start As Integer
Dim final As Integer
Dim v As range

start = 4
final = Worksheets("Sheet1").CurrentRegion.Rows.Count

For row = start To final
    Set v= Sheets("Sheet1").Rows(row)
    If WorksheetFunction.CountA(v) = 0 Then
        MsgBox "Row " & row & " has an empty cell.."
    Else
        highest = WorksheetFunction.Max(v)
    End If
    If v < highest Then
        v.Value = ""
    End If
Next row
End Sub

它在最后一个if语句中出错。不知道为什么。

Answer 1

这是解决问题的简单方法，请在代码中找到注释：

Dim rng As Range, cell As Range
Dim max As Integer

Set rng = Range("$A$1:" & Range("A1").End(xlToRight).Address) '<-- first of your rows
Do While rng(1) <> "" '<-- while you don't find a blank cell on first position
    max = Application.WorksheetFunction.max(rng) '<-- get the max of current row
    For Each cell In rng '<-- loop through the cells of your row
        If cell.Value <> max Then '<-- if the value of the cell is not the max
            cell.Value = "" '<-- set it to empty
        End If
    Next cell
    Set rng = Range(rng(1).Offset(1, 0).Address & ":" & rng(1).Offset(1, 0).End(xlToRight).Address) '<-- go the below line
    rng.Select
Loop

提示：不要直接在“最终”数据集上尝试使用您的代码（或者至少不要在尝试后保存文件），因为您将无法恢复修改。

至于你最近添加的代码，它之所以被破坏的原因是你将变量v声明为Range：

Dim v As Range

然后将其定义为整行：

Set v= Sheets("Sheet1").Rows(row)

然后你使用它就像它是一个单元格一样，因为你将它与一个声明为Double的变量（highest）进行比较：

If v < highest Then

你不能这样做只是因为你告诉代码一行（它是Sheet的一个对象）是否小于Double值，从中得到Type mismatch异常。