Option Explicit '强制声明变量开关打开
Sub test1() '声明过程
Dim A, i% '声明变量
Application.DisplayAlerts = False '关闭提示框
ThisWorkbook.Activate '设置活动工作簿
Sheets(1).Activate '设置活动工作表
A = [d6:o10] 'd6:o10装入数组
Sheets(2).Activate '设置活动工作表
Sheets(2).UsedRange.ClearContents '清空数据
[a1].Resize(UBound(A), UBound(A, 2)) = A '以a1为左上角写入数组内容
Range("b:b,j:k").Delete '删除b列,jk列
Columns("A:B").Insert 'a列前插入两列
Sheets(1).Activate '设置活动工作表
A = Sheets(2).[a1:k5] '把第二个表的a1:k5装入数组
For i = 1 To UBound(A) '循环
A(i, 1) = [z1] '数组A第一列全等于z1
A(i, 2) = [c4] '数组A第二列全等于c4
Next i '结束循环
Call test2(A) '调用test2,数组A作为参数
Range("a1:q10").SpecialCells(xlCellTypeConstants).ClearContents '清理常量
End Sub '结束
Private Sub test2(A) '声明过程
Dim p, f, r '声明变量
p = ThisWorkbook.Path & "\" '本文件的路径
f = "提取保存的数据.xls" '文件名
Call test3(f) '调用test3,f作为参数
Workbooks.Open p & f '打开工作簿
Sheets(1).Activate '设置活动工作表
r = Cells(Rows.Count, 1).End(xlUp).Row + 1 'a列最后一个有数据的单元格行号+1
Cells(r, 1).Resize(UBound(A), UBound(A, 2)) = A '把数组A内容写入到当前工作表,接在原有数据的下面
ActiveWorkbook.Close 1 '保存并关闭文件
End Sub '结束
Private Sub test3(f) '定义过程
On Error Resume Next '以下代码出现错误则执行下一条语句
Workbooks(f).Close 0 '不保存关闭文件
On Error GoTo 0 '禁止当前过程中已启动的错误处理程序
End Sub '结束