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

#excel #vba

Вопрос:

Я пытаюсь настроить высоту строки на основе значения ячейки. Операция должна выполняться через отфильтрованные данные, содержащие около 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

1. Вы обрабатываете 1 строку. Для каждой ячейки с данными вы настраиваете высоту строки. Итак, вы устанавливаете это, и устанавливаете, и устанавливаете, и…. Почему бы не просмотреть строку, чтобы один раз определить высоту, а затем после этого установить ее только один раз?

2. не могли бы вы показать мне, как сразу определить высоту строки?

3. Изменяется ли hgt от строки к строке или оно постоянное?

4. Вы пробовали Range("AJ6:AJ700").EntireRow.AutoFit

5. @KarthickGunasekaran К сожалению, это не работает, и я также пробовал функцию переноса текста. Кроме того, автоматическая подгонка не идеальна, поскольку я хотел бы оставить еще немного места между строками.

Ответ №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

1. Спасибо за вашу помощь. К сожалению, это не работает, поскольку я работаю с отфильтрованными данными. Эта операция не отфильтрует все. Кроме того, кажется, что выполнение этого кода занимает еще больше времени…

Ответ №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

1. Большое спасибо! Каждой строке я присвоил определенное значение высоты строки, поэтому я не пытаюсь установить для нее наибольшее значение. есть ли шанс, что я смогу сохранить значения в массиве, но я не очень уверен, как это сделать…