

正文开始前,需要先解释两个名词:
VBA:Visual Basic for Application,又称宏语言。是windows环境下开发应用软件的一种通用程序设计语言,功能强大,简便易用。
EXCEL VBA:广泛地应用于Microsoft公司开发的EXCEL软件中的一种通用设计语言。
最近接手的一项工作,涉及到一个较为复杂的excel表格,说较为复杂是因为表格中合并单元格较多,且合并单元格后,输入的文本内容很多,而excel中自动调整行高的功能在合并单元格中并不适用的,这就导致了这个每天都需上报的表格,需要手动来逐行调整行高,以达到完全显示合并单元格内文本和表格整体协调美观这两个目的。很显然,一项每天都会去做的重复工作,如果花费太多时间在调整格式这种细枝末节上,影响工作效率,是极其不划算的。所以,本人结合以前积累的excel vba基础知识,通过查阅一些既有资料,改进整理出以下代码(《通用型自动调整最适行高代码》见附件),并逐行进行了对照翻译。执行此代码只需单击预设的窗体按钮即可实现任意excel工作簿的自动调整最适行高,真可谓是“一劳永逸”呀。
使用EXCEL VBA不仅能轻松进行一些固定的重复操作,而且能进行复杂的逻辑运算和统计。仅以此文举例,愿我们打开思维,积极思考,乐于探索,让工作变得充满乐趣和更加高效。
附件:通用型自动调整最适行高代码
Sub 通用型自动调整最适行高() | '子程序 通用型自动调整最适行高() |
Dim rh As Single, mw As Single | '申明变量 rh 为单精度浮点型,mw 为 单精度浮点型 |
Dim rng As Range, rrng As Range, n1%, n2% | '申明变量 rng 为 Range型,rrng 为 Range型,n1%,n2% |
Dim aw As Single, rh1 As Single | |
Dim m$, n$, k | '申明变量 m$,n$为字符串型,k为整数型 |
Dim ir1, ir2, ic1, ic2 | '申明变量 ir1,ir2,ic1,ic2 |
Dim mySheet As Worksheet | '申明变量 mySheet 为工作表 |
Dim selectedA As Range | '申明变量 selectedA 为单元格区域 |
Dim wrkSheet As Worksheet | '申明变量 wrkSheet 为工作表 |
Application.ScreenUpdating = False | '运行屏幕刷新如果错误 |
Set mySheet = ActiveSheet | '设定活动工作表 |
On Error Resume Next | '当错误转到下一个循环 |
Err.Number = 0 | '错误代码=0 |
Set selectedA = Application.Intersect(ActiveWindow.RangeSelection, mySheet.UsedRange) | '设定单元格区域的属性 |
selectedA.Activate | '活动单元格区域 |
If Err.Number <> 0 Then | '如果错误代码<>0 则执行 |
g = MsgBox("请先选择需要'最合适行高'的单元格或行!", vbInformation) | '提示“请先选择需要最合适行高的单元格或行” |
Return | '循环 |
End If | '结束 |
selectedA.EntireRow.AutoFit | '单元格区域整行的最适行高 |
Set wrkSheet = ActiveWorkbook.Worksheets.Add | '设定增加的活动工作簿中的工作表 |
For Each rrng In selectedA | '设定变量范围为每一个rrng位于单元格区域 |
If rrng.Address <> rrng.MergeArea.Address Then | '如果 rrng.地址<>rrng.合并区域.地址则执行 |
If rrng.Address = rrng.MergeArea.Item(1).Address Then | '如果 rrng.地址=rrng.合并区域.Item(1).地址则执行 |
Dim tempCell As Range | '申明变量 tempCell 为Range型 |
Dim width As Double | '申明变量 width为双精度值型 |
Dim tempcol | '申明变量 tempcol |
width = 0 | '宽度=0 |
For Each tempcol In rrng.MergeArea.Columns | '设定变量范围为每一个tempcol位于rrng.合并区域.Columns |
width = width + tempcol.ColumnWidth | '宽度=宽度+tempcol.列宽 |
Next | '下一个 |
wrkSheet.Columns(1).WrapText = True | 'wrkSheet.Columns(1).文字换行=True |
wrkSheet.Columns(1).ColumnWidth = width | 'wrkSheet.Columns(1).列宽=宽度 |
wrkSheet.Columns(1).Font.Size = rrng.Font.Size | 'wrkSheet.Columns(1).字体.大小=rrng.字体.大小 |
wrkSheet.Cells(1,1).Value=rrng.Value | 'wrkSheet.单元格(1,1).属性=rrng.属性 |
wrkSheet.Activate | 'wrkSheet.Activate |
wrkSheet.Cells(1, 1).RowHeight = 0 | 'wrkSheet.单元格(1,1).行高=0 |
wrkSheet.Cells(1, 1).EntireRow.Activate | 'wrkSheet.单元格(1,1).整行.Activate |
wrkSheet.Cells(1, 1).EntireRow.AutoFit | 'wrkSheet.单元格(1,1).整行.自动调整行高 |
mySheet.Activate | 'mySheet.Activate |
rrng.Activate | 'rrng.Activate |
If (rrng.RowHeight < wrkSheet.Cells(1, 1).RowHeight) Then | '如果 (rrng.行高 |
Dim tempHeight As Double | '申明变量tempHeight为双精度值 |
Dim tempCount As Integer | '定义变量tempCount为整型值 |
tempHeight = wrkSheet.Cells(1, 1).RowHeight | 'tempHeight=wrkSheet.单元格(1,1).行高 |
tempCount = rrng.MergeArea.Rows.Count | 'tempCount=rrng.合并区域总行数 |
For Each addHeightRow In rrng.MergeArea.Rows | '设定变量范围为每一个增加的行高位于rrng.合并区域行数 |
If (addHeightRow.RowHeight < tempHeight / tempCount) Then | '如果平均行高怎么增加了则执行 |
addHeightRow.RowHeight = tempHeight / tempCount | '增加后平均的行高等于现在的行高除以总行数 |
End If | '结束 |
tempHeight = tempHeight - addHeightRow.RowHeight | '现在的行高是原来的行高减去增加的行高 |
tempCount = tempCount - 1 | '现在的行数是原来的行数减去1 |
Next | '下一个 |
End If | '结束 |
End If | '结束 |
End If | '结束 |
Next | '下一个 |
Application.DisplayAlerts = False | '运行提醒为错误 |
wrkSheet.Delete | '删除表格 |
Application.DisplayAlerts = True | '运行提醒为真 |
Application.ScreenUpdating = True | '运行更新为真 |
End Sub | '结束子程序 |