以下是本人Wen98在VBA工作實(shí)踐中，為方便查找，備忘性的積累了一些VBA常用的語(yǔ)句\函數(shù)\子過程，以提高自己一點(diǎn)工作效率。（僅供參考、引用）
獲取名字:
WorkbookName主表 =ActiveWorkbook.Name
Sheet透視表 =ActiveSheet.Name
選定:
Windows(WorkbookName主表).Activate
Sheets("取數(shù)").Select
Range("A1").Select
Range("K1:M3").Select
單元格賦值:
Range("A1")="Abc"
[A1]="Abc"
Cells(行,列)="123.00"
單元格跨薄引用(不打開工作薄而提取數(shù)據(jù)):
='F:\負(fù)債業(yè)務(wù)日?qǐng)?bào)\prg\[模板20.xls]金融資產(chǎn)'!F5:F5
或:
Range("A28").FormulaArray = "=[模板20.xls]金融資產(chǎn)!D4:D4"
Range("A28").Formula ="=[模板20.xls]金融資產(chǎn)!D4:D4"
是否顯示警告信息:
Application.DisplayAlerts = False 'True=顯示警告信息
顯示提示信息:
MsgBox "包括完整路徑的工作簿名稱為："& ThisWorkbook.FullName
選擇是否提示:
If MsgBox("設(shè)為匯總的單元格是:" & Selection.Address& " 確定嗎?", vbYesNo) = vbNo ThenExit Sub
關(guān)閉薄:
Windows(Workbook表).Close
刪除子表:
Sheets("操作步驟").Delete 或:
Sheets(Sheet透視表).Select
ActiveWindow.SelectedSheets.Delete
刪除行
Rows("2:316").Select
Application.CutCopyMode= False
Selection.DeleteShift:=xlUp
Range("A2").Select
刪除單元格:
Range("B5").Delete
對(duì)象的完整引用:
Windows("模板1.xls").Activate
Range("A28") =Application.Workbooks("模板20_表內(nèi)數(shù)據(jù)轉(zhuǎn)換2.xls").Sheets("操作步驟").Range("F7")
更簡(jiǎn)潔地:
[A28]=Workbooks("模板20.xls").Sheets("操作步驟").Range("F7")
復(fù)制單元格(帶格式):
Sub Macro1()
Range("A1:C3").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
End Sub
同薄復(fù)制單元格(帶格式)
Sub Macro_1()
Range("A1").CopyRange("C1")
End Sub
同薄復(fù)制單元格區(qū)域(空白為邊界)
Sub RngCopy()
Range("A1").CurrentRegion.Copy Range("G1") 'G1應(yīng)在當(dāng)前活動(dòng)工作表
或
Windows("模板20.xls").Activate
Worksheets("操作步驟").Range("F7").CurrentRegion.CopyWorksheets("發(fā)布0").Range("D9")
或 Sheets("操作步驟").Range("F7").CurrentRegion.CopySheets("發(fā)布0").Range("D9")
End Sub
同薄復(fù)制單元格,去掉多余的激活和選擇
Range("A1").Copy Sheets("Sheet2").Range("B1")
通過數(shù)組讀寫單元內(nèi)容(不帶格式):
Sub RngArr()
Dim arr As Variant '定義變量
arr =Range("A1:C3").Value '將A1：C3單元格的內(nèi)容存儲(chǔ)到數(shù)組arr里
Range("E1:G3").Value =arr '將數(shù)組arr的數(shù)據(jù)寫入E1:G3單元格區(qū)域
End Sub
實(shí)例:
Dim arr As Variant
Windows("模板20.xls").Activate
arr =Sheets("金融資產(chǎn)").Range("D4:AX82").Value
'
Windows("模板1.xls").Activate
Sheets("金融資產(chǎn)").Range("D4:AX82").Value = arr
全表復(fù)制粘貼:
Windows(Workbook表).Activate
Sheets("表1").Select
Cells.Select '全選
Selection.Copy
Windows(WorkbookName主表).Activate
Sheets("表2").Select
Cells.Select
ActiveSheet.Paste
Windows(Workbook表).Close
復(fù)制值:
Workbooks.OpenFilename:="存款表.xls"
Windows("模板20.xls").Activate
Sheets("發(fā)布").Select
Range("C4:H4").Select
Range(Selection,Selection.End(xlDown)).Select 'Shift+Ctrl+下鍵
' Range(Selection,Selection.End(xlToRight)).Select 'Shift+Ctrl+右鍵
' Range(Selection,ActiveCell.SpecialCells(xlLastCell)).Select 'Ctrl+End 鍵
Selection.Copy
Windows("存款表.xls").Activate
Sheets("人民幣").Select
Range("C4").Select
Selection.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '復(fù)制值
保存薄:
ActiveWorkbook.Save
新建薄并保存修改結(jié)果:(復(fù)制區(qū)域SUB,在下面）
Workbooks.Add
WorkbookName新薄 =ActiveWorkbook.Name
Call復(fù)制區(qū)域SUB((WorkbookName日?qǐng)?bào)表), "發(fā)布3", "A1:CF82", (WorkbookName新薄),"Sheet1", "A1")
Workbooks(WorkbookName新薄).Close SaveChanges:=True,Filename:=C_PRG路徑 & "測(cè)試表.xls"
原名保存文件，不顯示警告信息框
Application.EnableEvents= False
ActiveWorkbook.Save
Application.EnableEvents= True
關(guān)閉不保存，不顯示警告信息框
Application.DisplayAlerts = False '不顯示
ThisWorkbook.Close
Application.DisplayAlerts = True '顯示
是否顯示屏幕變化
Application.ScreenUpdating = False
Application.ScreenUpdating = True
是否顯示Excel界面
Application.Visible = False '不顯示Excel界面 True'False
Application.Visible = True
打開文件:
TXT_Name =Application.GetOpenFilename("文本文件(*.txt), *.txt") '獲取文件
Workbooks.OpenFilename:=TXT_Name
Workbooks.OpenFilename:=C_PRG路徑 & "模板5.XLS"
另一種:
IfMsgBox("[B1]單元內(nèi)容應(yīng)先設(shè)為讀取的文件名, 準(zhǔn)備好了嗎?", vbYesNo) = vbNo Then 'ExitSub
XLS_Name =Application.GetOpenFilename("Excel文件(*.xls), *.xls")
Range("B1") = XLS_Name
Else
XLS_Name = Range("B1") '讀取的文件名
End If
Workbooks.OpenFilename:=XLS_Name
Workbook表名 =ActiveWorkbook.Name
總行數(shù):
已用區(qū)域行數(shù) = Sheets("基金取數(shù)").UsedRange.Rows.Count '已用區(qū)域行數(shù)
已用區(qū)域列數(shù) = Sheets("基金取數(shù)").UsedRange.Columns.Count '已用區(qū)域行數(shù)
右下角地址 = Cells(已用區(qū)域行數(shù), 已用區(qū)域列數(shù)).Address
MsgBox Range("A1:" & 右下角地址).Address '區(qū)域地址
已用區(qū)域地址
MsgBox ActiveSheet.UsedRange.Address(0, 0) '已用區(qū)域地址
或:
已選定區(qū)域行數(shù) = Selection.Rows.Count '已選定范圍的行數(shù)
[B1] = 已用區(qū)域行數(shù)
或:
最后行號(hào) = Range("B5").End(xlDown).Row 'B列最后行號(hào),可用,B5下方不應(yīng)有空單元格
最后列號(hào) = Range("A4").End(xlToRight).Column
列名 = Columns(最后列號(hào)).Address '得出如: $N$N
最后行號(hào) = Cells(Rows.Count, 3).End(xlUp).Row 'C列最后行號(hào),比較通用
相當(dāng)于:
最后行號(hào) = Range("C65536").End(xlUp).Row '最后行號(hào),可用,V2003
獲取行列坐標(biāo):
列 = Selection.Column
行 = Selection.Row
或
列 = ActiveCell.Column
行 = ActiveCell.Row
設(shè)置公式(填充):(關(guān)聯(lián)的透視表最后列并不固定)
Sheets("透視表").Select
最后列號(hào) = Range("A4").End(xlToRight).Column '最后列號(hào)
列名 = Columns(最后列號(hào)).Address
Sheets("金額").Select
最后行號(hào) = Range("C4").End(xlDown).Row '最后行號(hào)
Range("E5").Select
ActiveCell.Formula = "=SUMIF(透視表!A:A,B:B,透視表!"& 列名 & ")" '設(shè)置公式
Selection.AutoFill Destination:=Range("E5:E" &最后行號(hào)) '填充
消除表內(nèi)容:
ActiveSheet.Cells.Clear
消除內(nèi)容:
Selection.ClearContents
把每個(gè)數(shù)字轉(zhuǎn)換成9位字符，不足者前面添0, 在單元格輸入公式:
=REPT(0,9-LEN(A23)) &A23
用代碼簡(jiǎn)化輸入(在[代碼]工作表中有A列代碼,B列名稱)
在工作表A列輸入代碼后,在B列得出名稱,B2單元格輸入公式:
=IF(ISERROR(VLOOKUP(A2,代碼!A:B,2,FALSE)),"",VLOOKUP(A2,代碼!A:B,2,FALSE))
凍結(jié)窗口
Range("C4").Select
ActiveWindow.FreezePanes= True '凍結(jié)窗口,C4起
查找包括X的單元格
Cells.Find(what:="X").Activate
列 = ActiveCell.Column
行 = ActiveCell.Row
或:
行號(hào) = Cells.Find(what:="X").Row
列號(hào) = Cells.Find(what:="X").Column
通過短名(簡(jiǎn)稱)求長(zhǎng)名代碼
=LOOKUP(0,0*FIND(簡(jiǎn)稱!$A$2:$A$112,A3),簡(jiǎn)稱!$B$2:$B$112)
其中:[簡(jiǎn)稱!$A$2:$A$112] 為簡(jiǎn)稱,[簡(jiǎn)稱!$B$2:$B$112] 為行號(hào),A3為網(wǎng)點(diǎn)全名
==================================================================================================
Sub 復(fù)制表1已用區(qū)域值到表2A1(源薄名 As String, 源表名 As String, 目標(biāo)薄名 AsString, 目標(biāo)表名 As String)
Windows(源薄名).Activate
With Sheets(源表名).UsedRange '整個(gè)已用區(qū)域,自動(dòng)計(jì)算區(qū)域大小
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).[A1].Resize(.Rows.Count,.Columns.Count) = .Value
End With
End Sub
==================================================================================================
Sub 復(fù)制表1區(qū)域值到表2(源薄名 As String, 源表名 As String, 源區(qū)域 As String,目標(biāo)薄名 As String, 目標(biāo)表名 As String, 目標(biāo)左上格 As String)
'自動(dòng)計(jì)算區(qū)域大小,目標(biāo)區(qū)域只需定位左上角單元格
Windows(源薄名).Activate
Sheets(源表名).Select
Range(源區(qū)域).Select
With Selection '已選定區(qū)域
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Range(目標(biāo)左上格).Resize(.Rows.Count,.Columns.Count) = .Value
End With
End Sub
==================================================================================================
Sub 數(shù)組方式復(fù)制整表(源路徑薄名 As String, 目標(biāo)薄名 As String, 目標(biāo)表名 As String)'比較快
'SUB:源薄名調(diào)用前已打開,復(fù)制后關(guān)閉 復(fù)制值'
'要求: 目標(biāo)區(qū)域只需定位左上角單元格
'調(diào)用: Call 數(shù)組方式復(fù)制整表(Worksheets("操作步驟").Range("G9").Value,(WorkbookName主表), "表內(nèi)人民幣")
Dim arr As Variant
Workbooks.OpenFilename:=源路徑薄名 'Worksheets("操作步驟").Range("G9").Value
源薄名 =ActiveWorkbook.Name
區(qū)域 =ActiveSheet.UsedRange.Address(0, 0) '已用區(qū)域地址
arr =Range(區(qū)域).Value
ActiveWorkbook.Close'關(guān)閉源薄
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Range(區(qū)域) =arr
End Sub
==================================================================================================
Sub 數(shù)組方式復(fù)制區(qū)域值SUB(源薄名 As String, 源表名 As String, 源區(qū)域 As String,目標(biāo)薄名 As String, 目標(biāo)表名 As String, 目標(biāo)區(qū)域 As String)
'SUB:源薄名調(diào)用前已打開不關(guān)閉 復(fù)制值'
'要求: 目標(biāo)區(qū)域 大小 = 源區(qū)域 大小
'調(diào)用: Call 數(shù)組方式復(fù)制區(qū)域值SUB((Workbook模板20), "金融資產(chǎn)", "D4:AX82",(WorkbookName日?qǐng)?bào)表), "金融資產(chǎn)", "D4:AX82")
Dim arr As Variant
Windows(源薄名).Activate
arr =Sheets(源表名).Range(源區(qū)域).Value
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Range(目標(biāo)區(qū)域).Value = arr
End Sub
==================================================================================================
Sub 數(shù)組方式復(fù)制區(qū)域值SUB2(源薄名 As String, 源表名 As String, 源區(qū)域 As String,目標(biāo)薄名 As String, 目標(biāo)表名 As String, 目標(biāo)左上格 As String)
'SUB:源薄名調(diào)用前已打開不關(guān)閉 復(fù)制值'
'要求: '自動(dòng)計(jì)算區(qū)域大小,目標(biāo)區(qū)域只需定位左上角單元格
'調(diào)用: Call 數(shù)組方式復(fù)制區(qū)域值SUB2((Workbook模板20), "金融資產(chǎn)", "D4:AX82",(WorkbookName日?qǐng)?bào)表), "金融資產(chǎn)", "D4")
Dim arr As Variant
Windows(源薄名).Activate
Sheets(源表名).Select
Range(源區(qū)域).Select
區(qū)域高 =Selection.Rows.Count
區(qū)域?qū)?=Selection.Columns.Count
arr =Sheets(源表名).Range(源區(qū)域).Value
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Range(目標(biāo)左上格).Resize(區(qū)域高, 區(qū)域?qū)? = arr
'MsgBoxSheets(目標(biāo)表名).Range(目標(biāo)左上格).Resize(區(qū)域高, 區(qū)域?qū)?.Address
End Sub
==================================================================================================
Sub 復(fù)制整表SUB(源薄名 As String, 源表名 As String, 目標(biāo)薄名 As String, 目標(biāo)表名As String)
'Application.DisplayAlerts = False 'True 顯示警告信息
Workbooks.OpenFilename:=源薄名 'Worksheets("操作步驟").Range("G9").Value
Workbook表 =ActiveWorkbook.Name
Sheets(源表名).Select
Cells.Select
Selection.Copy
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Select
Cells.Select
ActiveSheet.Paste
'Windows(Workbook表).Close
'Application.DisplayAlerts = True 'False 'True 顯示警告信息
End Sub
================================================================================
Sub 復(fù)制區(qū)域SUB(源薄名 As String, 源表名 As String, 源區(qū)域 As String, 目標(biāo)薄名As String, 目標(biāo)表名 As String, 目標(biāo)區(qū)域 As String)
Windows(源薄名).Activate
Sheets(源表名).Select
Range(源區(qū)域).Select
Range(Selection,Selection.End(xlDown)).Select
Selection.Copy
Windows(目標(biāo)薄名).Activate
Sheets(目標(biāo)表名).Select
Range(目標(biāo)區(qū)域).Select
Selection.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '復(fù)制值
End Sub
================================================================================
文件是否存在
Sub TestFile()
MsgBox"下面將判斷當(dāng)前目錄下是否存在“員工花名冊(cè).xls”工作薄文件。"
Dim fil As String '定義變量
fil = ThisWorkbook.Path& "\員工花名冊(cè).xls"
If Len(Dir(fil))> 0 Then '用Dir函數(shù)判斷fil指代的文件是否存在
MsgBox "工作薄已存在!"
Else
MsgBox "工作薄不存在!"
End If
End Sub
================================================================================
Function 工作表是否存在(表名 As String) As Boolean '自定義函數(shù):工作表是否存在
Dim i As Long
For i = Worksheets.CountTo 1 Step -1
If Worksheets(i).Name = 表名 Then
ExitFor
End If
Next
工作表是否存在 = IIf(i = 0,False, True) '如果i = 0工作表未找到
End Function
調(diào)用:
If 工作表是否存在((表名)) = FalseThen
Sheets.Add(after:=Sheets("成表")).Name = 表名 '"成表"之后插入
End If
=====================================================================================
Function 工作簿是否打開(sWkbName As String) As Boolean '自定義函數(shù):工作簿是否打開
'如果要判斷一個(gè)指定的工作簿是否打開，可以將下面的VBA代碼放入標(biāo)準(zhǔn)模塊中，然后在子過程中進(jìn)行調(diào)用。
'如果目標(biāo)工作簿已打開則返回TRUE，否則返回FALSE
Dim i As Long
For i = Workbooks.CountTo 1 Step -1
If Workbooks(i).Name = sWkbName Then
ExitFor
End If
Next
工作簿是否打開 = IIf(i = 0,False, True) '如果i = 0工作簿未找到
End Function
================================================================================
Sub 返回模板1()
If 工作簿是否打開("模板1.xls") =False Then
Workbooks.Open Filename:="F:\報(bào)表\日?qǐng)?bào)\prg\模板1.xls" '打開表
End If
Windows("模板1.xls").Activate
End Sub
=====================================================================================
Sub 打開或隱藏列()
Sheets("變動(dòng)表").Select
Columns("V:AO").Select
Selection.ColumnWidth =IIf(Selection.ColumnWidth > 0, 0, 12)
End Sub
=======================================================
Sub 打開或隱藏?zé)o關(guān)表()
Worksheets("過渡表").Visible = Not Worksheets("過渡表").Visible 'False 'True
Worksheets("匯總單位").Visible = Not Worksheets("匯總單位").Visible 'False 'True
End Sub
=======================================================
Sub 另存并關(guān)閉()
ActiveWorkbook.CloseSaveChanges:=True, Filename:="test.xls"
End Sub
=======================================================
標(biāo)題行輸入:
Dim myArray AsVariant
Dim i As Integer
ActiveSheet.Cells.Clear
'準(zhǔn)備數(shù)據(jù)
myArray = Array("AAA","BBB", 200, 500, "2006-7-12")
For i = LBound(myArray)To UBound(myArray)
Cells(i + 1, 1) = myArray(i)
Next i
=======================================================
Sub 設(shè)置片區(qū)匯總公式()
'用法: 先定位"分行匯總的單元格", 再運(yùn)行本宏, 即可自動(dòng)設(shè)置片區(qū)匯總公式
'分行匯總在最上面,片區(qū)匯總在網(wǎng)點(diǎn)下方(片區(qū)包含若干網(wǎng)點(diǎn))
'MsgBox ActiveCell.Column
If MsgBox("設(shè)為合計(jì)匯總的單元格是:" & ActiveCell.Address& " 確定嗎?", vbYesNo) = vbNo ThenExit Sub
列 = ActiveCell.Column '自動(dòng)得出
行0 = ActiveCell.Row '自動(dòng)得出
Dim A As Variant
'片區(qū)個(gè)數(shù) = 14
A = Array(10, 5, 3, 3, 4, 1, 2, 3, 2, 2, 9, 6, 6, 6)'各片區(qū)包含的網(wǎng)點(diǎn)個(gè)數(shù)(行)
行 = 行0
總計(jì) = "=SUM("
For i = 0 To UBound(A) '確定數(shù)組的指定維的最大可用下標(biāo)。
含 = A(i)
行 = 行 + 含 + 1
'Range(列& 行).Select
Cells(行, 列).Select'可行
ActiveCell.FormulaR1C1 ="=SUM(R[-" & 含 & "]C:R[-1]C)"
總計(jì) = 總計(jì)& "R[" & 行 - 行0 &"]C,"
Next
Cells(行0, 列).Select '可行
ActiveCell.FormulaR1C1 = 總計(jì) & ")" '總計(jì)
End Sub
=========================================================
Sub 匹配簡(jiǎn)稱獲取行號(hào)Find()
N行數(shù)1 = Sheets("行名簡(jiǎn)稱").UsedRange.Rows.Count '行名簡(jiǎn)稱
N行數(shù)2 = Sheets("操作表").UsedRange.Rows.Count '操作表
'清除B列
Sheets("操作表").Select
Range("B2:B" & N行數(shù)2).Select
Selection.ClearContents
Dim W行名簡(jiǎn)稱 As Worksheet
Set W行名簡(jiǎn)稱 = Worksheets("行名簡(jiǎn)稱")
Dim W操作表 As Worksheet
Set W操作表 = Worksheets("操作表")
For i = 2 To N行數(shù)1 '行名簡(jiǎn)稱
C行名簡(jiǎn)稱 =Trim(W行名簡(jiǎn)稱.Cells(i, 4))
C代號(hào) = W行名簡(jiǎn)稱.Cells(i, 6) '歸并行號(hào)
If Len(C行名簡(jiǎn)稱) > 0 Then
For j = 2 To N行數(shù)2 '操作表
With W操作表.Cells(j, 1)
Set YN = .Find(C行名簡(jiǎn)稱)
End With
If Not YN Is Nothing Then
W操作表.Cells(j, 2) = C代號(hào)
End If
Next j
End If
Next i
MsgBox "OK !"
End Sub
===========================================================================
問題一：在VBA代碼中，如何引用當(dāng)前工作表中的單個(gè)單元格(例如引用單元格C3)？
回答：可以使用下面列舉的任一方式對(duì)當(dāng)前工作表中的單元格(C3)進(jìn)行引用。
(1) Range("C3")
(2) [C3]
(3) Cells(3, 3)
(4) Cells(3, "C")
(5) Range("C4").Offset(-1)
Range("D3").Offset(, -1)
Range("A1").Offset(2, 2)
(6) 若C3為當(dāng)前單元格，則可使用：ActiveCell
(7) 若將C3單元格命名為“Range1”，則可使用：Range("Range1")或[Range1]
(8) Cells(4, 3).Offset(-1)
(9) Range("A1").Range("C3")
**************************************************************************************************
Sub 讀寫機(jī)構(gòu)號(hào)()
'
' 宏由 gd-wenbirong 錄制，時(shí)間: 2012-12-24
'
' (13180-BEPD0010) 往賬清單.txt
'
'用Excel打開往賬清單.txt,按空格符分列,運(yùn)行這個(gè)宏,
'排序,刪除無(wú)用行,透視表,關(guān)聯(lián)網(wǎng)點(diǎn)名,OK
'
C機(jī)構(gòu)號(hào) = ""
For i = 1 To 1832
If Left(Cells(i, 1), 4) = "機(jī)構(gòu)號(hào):" Then
C機(jī)構(gòu)號(hào) = Mid(Cells(i, 1),6, 5) '讀
'MsgBox C機(jī)構(gòu)號(hào)
End If
Cells(i, 14) = C機(jī)構(gòu)號(hào)'寫
Next i
End Sub
=======================================
Sub 基金透視表()
'
' Macro4 Macro
' 宏由 gd-wenbirong 錄制，時(shí)間: 2012-12-4
'
'
Sheets("基金取數(shù)").Select
有效行 =Sheets("基金取數(shù)").UsedRange.Rows.Count '已用區(qū)域行數(shù)
Range("H1") = 有效行 '通過H1單元過渡
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=_
"基金取數(shù)!R1C1:R" & Range("H1")& "C7").CreatePivotTable TableDestination:="",TableName:= _
"數(shù)據(jù)透視表1",DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3,1)
ActiveSheet.Cells(3,1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
WithActiveSheet.PivotTables("數(shù)據(jù)透視表1").PivotFields("資金賬戶開戶機(jī)構(gòu)")
.Orientation = xlRowField
.Position = 1
End With
WithActiveSheet.PivotTables("數(shù)據(jù)透視表1").PivotFields("基金類型")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("數(shù)據(jù)透視表1").AddDataFieldActiveSheet.PivotTables("數(shù)據(jù)透視表1" _
).PivotFields("余額（份數(shù)）"), "求和項(xiàng):余額（份數(shù)）",xlSum
Application.CommandBars("PivotTable").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Sheet透視表名 =ActiveSheet.Name
Cells.Select 'copy to"基金透視表"
Selection.Copy
Sheets("基金透視表").Select
Cells.Select
Selection.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
有效行 =Sheets("基金透視表").UsedRange.Rows.Count '已用區(qū)域行數(shù)
Range("Q4") = 有效行 '通過P4單元過渡
Range("Q5").Select
ActiveCell.FormulaR1C1 ="=RC[-1]-RC[-4]-RC[-3]" '減去: -M列(12 中銀理財(cái)) -N列(13信托)
Selection.AutoFillDestination:=Range("Q5:Q" & Range("Q4"))
'Range("Q5:P"& Range("Q4")).Select
Range("Q4") = "純基金"'增加列
Sheets(Sheet透視表名).Select
Application.DisplayAlerts = False 'True顯示警告信息
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True 'True顯示警告信息
'Application.CutCopyMode= False
Sheets("基金透視表").Select
End Sub
===========================================================================
Sub test運(yùn)行時(shí)間()
Application.ScreenUpdating = False '是否顯示屏幕變化
xls1 = "模板1.xls"
xls2 = "模板20.xls"
tim = Timer
For i = 1 To 100
Call 復(fù)制表1區(qū)域值到表2((xls2), "金融資產(chǎn)", "D4:AX82", (xls1), "金融資產(chǎn)","D4") 'test 可用
Next
MsgBox Format(Timer - tim, "0.00") & "秒"
tim = Timer
For i = 1 To 100
Call 數(shù)組方式復(fù)制區(qū)域值SUB((xls2), "金融資產(chǎn)", "D4:AX82", (xls1), "金融資產(chǎn)","D4:AX82") 'test 較快
Next
MsgBox Format(Timer - tim, "0.00") & "秒"
Application.ScreenUpdating = True
End Sub
