处理excel报表的常用VBA语句（自用）

• 打开、保存与关闭excel文件

Workbooks.Open ("C:\text.xlsm"), ReadOnly:=True '以只读形式打开对应路径的工作簿
ActiveWorkbook.Close SaveChanges:=False '关闭不保存
ActiveWorkbook.Save

'按日期保存到指定路径
FolderName = Format(Date, "mm-d") '当前月份日期
Filename = "AA " & Format(Date, "yyyymmdd") & " " & Format(Time, "hhmm")
PathName = "D:\Desktop\"
If Dir(PathName & FolderName, vbDirectory) = "" Then
    MkDir PathName & FolderName
End If
ActiveWorkbook.SaveAs Filename:=PathName & FolderName & "\" & Filename & ".xlsx", FileFormat:=xlWorkbookDefault

Shell "Explorer.exe " & PathName, vbNormalFocus '用Explorer打开文件夹

'抓取桌面的路径
Dim wshshell As Object
Set wshshell = CreateObject("wscript.shell") 
PathName = wshshell.regread("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\desktop")

• 表格边界数据

'获取表格使用的最右列和最后一行，但是根据实际经验，可能会有没删干净的数据残留，造成这两个量并不符实
ActiveSheet.UsedRange.Columns.Count
ActiveSheet.UsedRange.Rows.Count

Range("iv1").End(xlToLeft).Column '第一行的最右列
cells(1,16384).End(xlToLeft).Column '第一行的最右列
Range("A65536").End(xlUp).Row  '第一列的最后一行
cells(65535,1).End(xlUp).Row  '第一列的最后一行

ActiveSheet.Name '获取当前工作表名
ActiveWorkbook.Name '获取当前工作簿名
Workbooks(i).Name '遍历工作簿时，获取逐个工作簿名

 

• 简易清洗数据

无用行列直接删除是比较直接的办法，删除顺序是从下往上，从右往左，这样效率略高。缺点是数据量和删除的操作次数一多，会产生很多冗余的移动操作，影响程序运行速度。可以考虑建立一个新的表，从原表中提取出需要的行列数据。还有一个缺点是会造成行列的移动，造成删除后所需的数据在哪个行列需要重新选取，写程序时对应起来会比较麻烦。

Cells.ClearContents '删除所有内容
Rows(1).Delete '删除单行
Rows("1:2").Delete '删除多行，还未发现可以隔行删除
Range(Cells(1,1),Cells(2,1)).EntireRow.Delete

Columns(3).Delete '删除单列
Columns("A:B").Delete '删除多列，使用Range也可以
'可以活用Resize和EntireRow/EntireColumn组合，对某一特定行/列的周围统一处理

Range("a3").Delete shift:=1  '右侧单元格左移
Range("a3").Delete shift:=2   '下方单元格上移（默认）
Range("a3").Delete shift:=3   '整行删除
Range("a3").Delete shift:=4   '整列删除

Cells(p, 2).Delete Shift:=xlToLeft '删格子
Cells(1, 2).Insert Shift:=xlShiftToRight '加格子

Columns(6).Resize(, 2).Insert '加2列

 

• 整理操作

'If MsgBox("是否生成账单？", vbOKCancel, "提示") = vbOK Then 'IF的提示窗
Columns("D:D").EntireColumn.AutoFit '自动调整列宽
Columns("I:I").Insert Shift:=xlToLeft  '在I列左边插入

Range("A2:G" & bottom).Sort key1:=Range("F1"), order1:=xlDescending,Header:=xlNo '简易排序
'增加排序索引的排序方式
    Workbooks("CNSKU").Worksheets("FB").Sort.SortFields.Clear
    Workbooks("CNSKU").Worksheets("FB").Sort.SortFields.Add2 Key:= _
        Cells(1, 10), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With Workbooks("CNSKU").Worksheets("FB").Sort
        .SetRange Range(Cells(2, 1), Cells(bottom, 10))
        .Header = xlNo
        .SortMethod = xlPinYin
        .Apply
    End With

 

• excel 开关

Application.DisplayAlerts = False '关闭提示框
Application.ScreenUpdating = False '关闭屏幕刷新
Application.CutCopyMode = False '取消复制内容
Application.EnableEvents = False '在进行下面的操作时禁止事件程序再次运行，陷入无限递归
Selection.EntireColumn.Hidden = True '隐藏列
Cells.EntireColumn.Hidden = False '取消列隐藏
Cells.EntireRow.Hidden = False '取消行隐藏
ActiveSheet.AutoFilterMode = False '取消筛选模式
ActiveSheet.FilterMode = False '解开筛选

• 其他常用

'清空文件夹
PathName = "D:\download\ " & Format(Date, "m-d") & "\"
CreateObject("scripting.filesystemobject").deletefile PathName & "*.*"

'上色
Cells(i, 3).Interior.Color = RGB(193, 255, 193)
Cells(i, 3).Interior.Pattern = xlNone
'Cells(i, 8).Interior.ColorIndex > 0

'将字符串转化为日期
CDate(Right(Range("G12"), 4) & "/" & Mid(Range("G12"), 13, 2) & "/" & Mid(Range("G12"), 10, 2)) + TimeValue(Left(Range("G12"), 2) & ":" & Mid(Range("G12"), 3, 2)))
'函数设置空缺值的赋值
Sub SaveFile(ByRef TableName As String, Optional FindAttName As String = "")

'给表格增加边框
    With Range(Cells(1, 1), Cells(bottom, 22)).Borders
        .LineStyle = xlContinuous '加默认边框格
        .Weight = xlHairline '虚线
        .ColorIndex = 48
    End With