自動(dòng)化流程

我們對(duì)一個(gè)報(bào)表進(jìn)行自動(dòng)化改造會(huì)經(jīng)歷的固定流程，這里稱為“流水線”，通常包含以下流程：

• 打開(kāi)一個(gè)表格
• 選擇打開(kāi)的表格
• 選擇表格中的Sheet
• 選擇Sheet中的單元格區(qū)域 （有時(shí)候需要按條件篩選）
• 復(fù)制某個(gè)區(qū)域 粘貼在某個(gè)區(qū)域
  （有時(shí)候需要刷新某個(gè)透視表）
  完成后保存
  最后一步關(guān)閉表格
  

以下是一段包含了上述過(guò)程的腳本

基礎(chǔ)復(fù)制粘貼和填充公式

'基礎(chǔ)復(fù)制粘貼和填充公式
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("數(shù)據(jù)透視表3")
pt.PivotCache.Refresh'獲取需要復(fù)制區(qū)域的最后一行行號(hào)
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區(qū)")'獲取準(zhǔn)備粘貼區(qū)域的第一個(gè)為空行的行號(hào)（粘貼起始位置）
lastRow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row + 1'粘貼
ws2.Range("A" & lastRow).PasteSpecial xlPasteValues'獲取粘貼后的區(qū)域的最后一行行號(hào)
lastRow = ws2.Range("A" & ws2.Rows.Count).End(xlUp).Row 
‘將F:H列的公式填充導(dǎo)最后一行
With ws2.Range("F2:H2")
.AutoFill Destination:=ws2.Range("E2:H" & lastRow)
End Withwb1.Save
wb1.Close
wb2.Save
wb2.Close

數(shù)據(jù)篩選

'數(shù)據(jù)篩選
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)'篩選數(shù)據(jù)范圍
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'將篩選后的數(shù)據(jù)復(fù)制到Sheet3的A2單元格開(kāi)始的區(qū)域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'以下這種寫(xiě)法在功能上是等效的，即將filteredData復(fù)制到A2單元格開(kāi)始的位置。
'但是，它使用了Select和Activate語(yǔ)句，這是不推薦的。
'使用Select和Activate語(yǔ)句會(huì)使代碼變得緩慢且容易出錯(cuò).
'應(yīng)該直接將filteredData的值賦給目標(biāo)區(qū)域(Value)‘filteredData.Copy 
’Range("A2").Select
‘Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _’   :=False, Transpose:=False'清除篩選
filterRange.AutoFilter'釋放對(duì)象內(nèi)存
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)'篩選數(shù)據(jù)范圍賦值filteredData
'使用Offset方法將filterRange對(duì)象向下偏移1行，以排除標(biāo)題行。
'然后使用Resize方法調(diào)整數(shù)據(jù)區(qū)域的大小，使其與filterRange對(duì)象的行數(shù)相同，但不包括標(biāo)題行。
'使用SpecialCells方法和xlCellTypeVisible參數(shù)，獲取可見(jiàn)單元格范圍，即篩選后的數(shù)據(jù)區(qū)域。
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