简体   繁体   中英

VBA - Base Rowheigth on Font size

I've been working with Excel-VBA for a few weeks now, and have learned a lot, especially from StackOverflow. I just have one problem that's beyond me.

I've made an Excel workbook for a price list in 6 versions. It has to be designed so that only one version has to be corrected in case of changes or errors; the other versions will be changed with the press of a button. Everything works, except for one thing: I want row heights to change based on the font size of one cell in that row.

Specifically, the third column sometimes contains headers with a font size of 20. In that case, the row height needs to be 26.25. In all other cases, the row height must be 12.75. Currently I'm using the following code. It seems to work, but it's painfully slow:

For j = 1 To lastrow
If Cells(j, 3).Font.Size = 20 Then
Rows.Cells(j, 3).RowHeight = 26.25
Else
Rows.Cells(j, 3).RowHeight = 12.75
End If
Next j

I've tried some other things, including the following code (with cell and nicrange declared as Range), but that doesn't work:

For Each cell In nicrange
If cell.Font.Size = 20 Then
cell.RowHeight = 26.25
Else
cell.RowHeight = 12.75
End If
Next

It's probably just a simple mistake, but I can't figure it out. Any help would be much appreciated. Thank you!

Sander

Use this approach to get the lastRow . Then, simplify your condition:

For j = 1 To lastrow
    With Cells(j,3)
        .RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
    End With
Next

If lastRow is a very large number, then this requires many iterations, and can usually be optimized by disabling ScreenUpdating and Calculation

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For j = 1 To lastrow
    With Cells(j,3)
        .RowHeight = IIF(.Font.Size = 20, 26.25, 12.75)
    End With
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM