Excel宏（VBA）自动化标准流程代码

流程代码"/>

Excel宏（VBA）自动化标准流程代码

自动化流程

我们对一个报表进行自动化改造会经历的固定流程，这里称为“流水线”，通常包含以下流程：

• 打开一个表格
• 选择打开的表格
• 选择表格中的Sheet
• 选择Sheet中的单元格区域 （有时候需要按条件筛选）
• 复制某个区域 粘贴在某个区域
  （有时候需要刷新某个透视表）
  完成后保存
  最后一步关闭表格
  

以下是一段包含了上述过程的脚本

基础复制粘贴和填充公式

'基础复制粘贴和填充公式
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, pt As PivotTable
Dim lastRow As Long
Set wb1 = Workbooks.Open("表格21.xlsx")
Set ws1 = wb1.Sheets("Sheet1")
Set pt = ws1.PivotTables("数据透视表3")
pt.PivotCache.Refresh'获取需要复制区域的最后一行行号
lastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
ws1.Range("A6:D" & lastRow).CopySet wb2 = Workbooks.Open("表格44.xlsx")
Set ws2 = wb2.Sheets("H433区")'获取准备粘贴区域的第一个为空行的行号（粘贴起始位置）
lastRow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1'粘贴
ws2.Range("A" & lastRow).PasteSpecial xlPasteValues'获取粘贴后的区域的最后一行行号
lastRow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row 
‘将F:H列的公式填充导最后一行
With ws2.Range("F2:H2")
.AutoFill Destination:=ws2.Range("E2:H" & lastRow)
End Withwb1.Save
wb1.Close
wb2.Save
wb2.Close

数据筛选

'数据筛选
Dim ws As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Dim filteredData As Range
Dim n As LongSet ws = ThisWorkbook.Worksheets("Sheet1")lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set filterRange = ws.Range("A1:AF" & lastRow)'筛选数据范围
With filterRange.AutoFilter Field:=7, Criteria1:=">=" & DMin, Operator:=xlAnd, Criteria2:="<=" & DMaxSet filteredData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
End WithIf Not filteredData Is Nothing Then'将筛选后的数据复制到Sheet3的A2单元格开始的区域Set ws = ThisWorkbook.Worksheets("Sheet3")ws.Range("A2").Resize(filteredData.Rows.Count, filteredData.Columns.Count).Value = filteredData.Valuews.Range("A" & lastRow + 1 & ":AF" & ws.Rows.Count).ClearContents
End If'以下这种写法在功能上是等效的，即将filteredData复制到A2单元格开始的位置。
'但是，它使用了Select和Activate语句，这是不推荐的。
'使用Select和Activate语句会使代码变得缓慢且容易出错.
'应该直接将filteredData的值赋给目标区域(Value)‘filteredData.Copy 
’Range("A2").Select
‘Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _’   :=False, Transpose:=False'清除筛选
filterRange.AutoFilter'释放对象内存
Set ws = Nothing
Set filterRange = Nothing
Set filteredData = Nothing

筛选删除

Dim ws As Worksheet
Dim lastRow As Long
Dim filterRange As Range
Dim filteredData As Range
Dim n As LongSet ws = ThisWorkbook.Worksheets("Sheet1")lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set filterRange = ws.Range("A1:AF" & lastRow)'筛选数据范围赋值filteredData
'使用Offset方法将filterRange对象向下偏移1行，以排除标题行。
'然后使用Resize方法调整数据区域的大小，使其与filterRange对象的行数相同，但不包括标题行。
'使用SpecialCells方法和xlCellTypeVisible参数，获取可见单元格范围，即筛选后的数据区域。
With filterRange
.AutoFilter Field:=7, Criteria1:=">=" & DMin, Operator:=xlAnd, Criteria2:="<=" & DMax
Set filteredData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
End WithIf Not filteredData Is Nothing Then
'删除不符合条件的行
filteredData.EntireRow.Delete
End If
'取消筛选
filterRange.AutoFilter