#excel #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. Большое спасибо! Каждой строке я присвоил определенное значение высоты строки, поэтому я не пытаюсь установить для нее наибольшее значение. есть ли шанс, что я смогу сохранить значения в массиве, но я не очень уверен, как это сделать…