Оптимизация кодов VBA - высота строки на основе значений ячеек

Question

Я пытаюсь настроить высоту строки на основе значения ячейки. Операция должна проходить через отфильтрованные данные с около 700 строк.

Приведенный ниже код работает, но для завершения операции требуется 2-3 минуты, что слишком долго.

Есть ли шанс, что я могу сделать это без цикла? Или, пожалуйста, дайте мне знать, если есть что-то еще, что я должен сделать, чтобы сократить время операции.

Большое спасибо за вашу помощь!

Sub rowheight()

Dim hgt As Integer
Dim WorkRng As Range

Application.ScreenUpdating = False

Set WorkRng = Range("AJ6:AJ700")

For Each C In WorkRng.SpecialCells(xlCellTypeVisible)

    If C.Value > 0 Then
        hgt = C.Value
        C.EntireRow.rowheight = hgt
    End If
Next C

Application.ScreenUpdating = True


End Sub

Answer 1

Вы можете попробовать:

Option Explicit

Sub test()

    Dim i As Long, arr As Variant

    With ThisWorkbook.Worksheets("Sheet1")

        arr = .Range("AJ6:AJ700")

        For i = LBound(arr) To UBound(arr)

            If arr(i, 1) > 0 Then
                .Rows(i + 5).EntireRow.rowheight = arr(i, 1)
            End If

        Next i

    End With

End Sub

Answer 2

Если предположить, что большая часть обработки выполняется при установке высоты строки, и при условии, что вы хотите установить наибольшее значение, функция будет выглядеть так:

Sub rowheight()
    Dim hgt As Integer
    Dim WorkRng As Range

    Application.ScreenUpdating = False

    Set WorkRng = Range("AJ6:AJ700")

    hgt = 0
    For Each c In WorkRng.SpecialCells(xlCellTypeVisible)
        If c.Value > hgt Then
            hgt = c.Value
        End If
    Next c
    WorkRng.EntireRow.rowheight = hgt

    Application.ScreenUpdating = True
End Sub