Код для удаления макс строки не работает последовательно

Question

Я работал над кодом, который удаляет ячейки, которые не содержат максимум этой строки. Этот код будет использоваться в файлах с похожей разметкой, просто с другими данными. Сработало с первого раза. Однако, когда я пробую это в других файлах с такими же условиями и разными данными, код иногда удаляет целые строки, даже если есть очевидный максимум. Удаленные строки случайны между файлами. Я попытался установить другое, менее сложное условие, установив правило для жирного максимума вместо удаления. Однако проблема повторяется (она не выделяет максимум некоторых строк. Те же, что не были удалены ранее). Это наводит меня на мысль, что проблема заключается либо в самом максимуме, либо в чем-то в ячейках.

Sub deletenonmax()
Dim rng As Range, cell As Range
Dim max As Integer

Set rng = Range("$E$10:" & Range("E10").End(xlToRight).Address) '<-- first of my rows
Do While rng(1) <> "" '<-- If excel does not detect a blank cell on the first position
    max = Application.WorksheetFunction.max(rng) '<-- This is how I get the max of current row
    For Each cell In rng '<-- loop through the cells of the 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 to the line below
    rng.Select
Loop
End Sub

В некоторых случаях он действительно удаляет все, НО максимальные значения строки, но в некоторых других случаяхвесь ряд заканчивается пустым. Моя цель состоит в том, чтобы код последовательно удалял все числа, которые не являются максимальными в строке.

Я не могу прикрепить изображения, поэтому я надеюсь, что вы можете мне помочь.

Спасибо!

Answer 1

Я предлагаю вместо этого попробовать такой код (измененный по мере необходимости):

Option Explicit
Sub deleteMax()
Dim r As Range, cell As Range, sh As Worksheet
Set sh = ActiveSheet
Set r = sh.Range("E10")
While r(1) <> ""
    Set r = sh.Range(r, r.End(xlToRight))
    For Each cell In r
        'cell.Select
        If cell <> Application.WorksheetFunction.Max(r) Then cell.Font.Color = vbRed
    Next cell
    Set r = r(1).Offset(1, 0)
Wend
End Sub

Это сработало для меня как для целых, так и для действительных чисел, как показано ниже в 2 примерах, которые я пробовал. Я просто покрасил их в красный цвет, но, конечно, вы хотели бы удалить их, используя cell = ""

Если есть набор данных, который не работает с этим кодом, дайте мне знать.