代码如下:Sub 动态设置行高() Dim rown As Integer Dim high As Integer Dim charlen As Integer Dim Lrow As Long ' Dim Rng As Range Dim szs As Integer Dim zms As Integer Lrow = Range("D" & Cells.Rows.Count).End(xlUp).Row - 1 For rown = 2 To Lrow + 1 ' Rng = Range("D" & rown) Set reg1 = CreateObject("VBSCRIPT.REGEXP") Set reg2 = CreateObject("VBSCRIPT.REGEXP") reg1.Pattern = "d{1}" reg2.Pattern = "[A-Za-z]{1}" reg1.Global = True reg2.Global = True Set sz = reg1.Execute(Range("D" & rown)) Set zm = reg2.Execute(Range("D" & rown)) szs = sz.Count zms = zm.Count charlen = Len(Range("D" & rown)) - szs / 2 - zms / 2 high = Application.Round(charlen / 50 + 0.5, 0) - 1 Rows(rown & ":" & rown).Select Selection.RowHeight = 20 + high * 16 Next rownEnd Sub
代码分析:确定D列中第一个单元格的字符数量,一行所能容纳的字符数量,算出容纳文字所需的行数(有考虑数字与字母所占宽度与汉字的差别),然后再按行数设置适当的行高。