EXCEL VBA在实际工作中的应用分享

发布时间:2017-08-07 作者:贺情 浏览量:【字体:

正文开始前,需要先解释两个名词:

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

'申明变量 aw 为单精度浮点型,rh1 为单精度浮点型

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

'结束子程序

长沙市轨道交通集团官网

Copyright@2001-2017 长沙轨道交通 All RIGHTS RESERVED

湘ICP备14000339号-1湘公网安备 43011102000432号

总访问量: 更新文章数: