VBA笔记

• 打开VBE即编写VBA的IDE的快捷键 ALT+ F11

• 提示代码 CTRL+j

• 在代码窗口VBA.会自动列出所有的函数

• 在VBE的帮助中输入对象模型就能看到对象的关系了

• 引用类型

  $A$1            //绝对引用，复制公式时不改变单元格地址
  

  • A1
    • 相对引用，复制公式时会改变引用单元格地址

IF（逻辑值，TRUE时的返回结果，FALSE时返回的结果）

&在表中是连接符，连接表格的内容

VBA的数据类型

• 字节 Byte
• 整数 Integer
• 长整型 Long
• 单精度浮点型 Single
• 双精度浮点型 Double
• 货币型 Currency
• 小数型 Decimal
• 字符串型 String
• 日期型 Date
• 布尔型 Boolean

Dim 变量名 As 数据类型

Dim Str As String*10 //因为String存的数据的长度比较长，可以指定 它的长度

变量声明符声明 变量

  Dim Str$     变量Str被声明为了 String类型
  Integer    %
  Long      &
  Single     !
  Double    #
  Currency    @
  String       $

不指定类型，默认声明成Variant类型

• Option Explicit 加到Sub第一句强制声明变量，不然编译不过

给对象变量（Object型，如单元格）赋值

• Set 变量名称 =对象
• Dim rng As Range
• Set rng = Worksheets(“Sheet1”).Range(“A1”)
• rng.Value=“欢迎来到VBA”

声明常量

• Const 变量名称 AS数据类型 =数值

声明数组

• Dim array (1 to 3) As String //声明了一维字符串数组，长度为3

• array(1)=“hello array!” //对数组赋值

• Dim array(3) As String //从0开始的数组 ，0~3

• 可以在模块的第一句加 Option Base 1让索引 从1开始

• 多维数组

  • Dim arrays (1 to 3, 1 to 20) As Byte
  • Dim arrays (2,19) As Byte

• 动态数组

  • Dim autoArray () As Byte
  • 在程序使用中用ReDim重新指定大小

• 其他方式创建数组

• Dim arr As Variant //必须声明为Variant

• arr=Array(1,2,.3,4,5,6)

• MsgBox(“arr数组的第2个元素是:”&arr(1))

• Split分割成函数

• Dim arr As Variant

• arr=Split(“a,b”,",") //分割逗号

• 通过Range对象直接创建数组

• 把单元格里的值直接存储到数组里

• Dim arr As Variant

• arr=Range(“A1:C3”).Value //把单元格里的值直接赋给数组

• Range(“E1:G3”).Value=arr //数组又把值赋值给单元格 大小要匹配

UBound(arr) //返回数组 的最大索引 号 多维数组要指定 维数UBound(arr,2)

LBound(arr) // 返回数组 的最小索引 号

UBound(arr) -LBound(arry) + 1 // 计算出数组长度

Chr(13) //相当于按了一次回车

Join拼接字符

• Dim arr As Variant,txt As String
• arr=Array (1,2,3)
• txt=Join (arr,"@") //拼成1@2@3

将数组所有元素批量写入单元格

• Dim arr As Variant
• arr=Array(1,2,3) // 大 小要一致
• Range(“A1:A3”).Value=Application.WorksheetFunction.Transpose(arr) //Transpose指的是垂直，这里表示垂直写入

Application.Workbooks(“工作簿”).Worksheets(“表1”).Range(“A2单元格”)

• Application代表Excel
• workbooks代表一个包含多个对象的集合
• 如果工作簿是活动工作簿，可简写成
  • Worksheets(“表1”).Range(“A2”)
  • 如果表1是活动工作表，又能简写成
    • Range(“a2”)

运算符

• / 求商 5/2=2.5
• \ 整除 5\2=2
• Mod 取模
• <> 不等于
• 对象1 Is 对象2 //当是相同的引用时返回True,不是时返回False
• 字符串1 Like 字符串2 //当字符串1与字符串2匹配时返回True ,否则返回False

通配符
*     代表任意多个字符    "abc"  Like "*b*" =True
?    代表任意一个字符 
#   代表任意一个数字 
[列表]    代替列表中的任意一个字符   "I"  Like "[A-Z]" =True
[!列表]   代替不在列表 中的任意一个字符  "I" Like [!H-J] =False

在立即窗口输入命令时？代表Debug.Print

逻辑运行符

• And
• Or
• Not
• Xor
• Eqv //等价//表达式1 Eqv 表达式2 当表达式1和表达式2返回的值相同时返回True,否则返回False
• Imp //蕴含 表达式1 iImp 表达式2 1True2False时为False ,否则返回True 相当于Not表达式1Or表达式2

IF 条件 Then 为真时执行 Else 为假时执行

IF 条件 Then

为真时执行

Else

为假时执行

End If

Select Case 条件

Case 条件1

执行语句 //执行完这句就自动跳出了

Case 条件2

执行语句 //执行完这句就自动跳出了

Case Else

相当于Default的语句在这执行

End Select

Cells(行，列) 返回单元格

Dim i As Integer

For i=2 To 19 Step 1

​ XXXX

​ if xxx

Exit For //相当于break

Next i

Dim i As Integer

i=2

Do While 条件

​ if xxx

Exit Do

Loop

Do

​ if xxx

Exit Do

Loop While 条件

Dim i As Integer

i=2

Do Until 条件

​ if xxx

Exit Do

Loop

Do

​ if xxx

Exit Do

Loop Until 条件

For Each 变量 in 变量列表

​ XXXX

​ if xxx

Exit For //相当于break

Next 变量

With Range(“a1”).Font

.Name=“ccc”

.Size=sss

End With

调用函数 Sub a()

• a //直接函数名
• Call a //加个Call
• Application.Run “a” //整个不一样的

自定义有返回值的函数

Public Function Fun(arr As Range) //可以指定形参为单元格变量

Application.Volatile True //将函数声明成易失性函数，工作表重算时会自动重算，不然生成一次随机数就不变化了，但是如果是改变单元格的颜色，加不加都不会导致重算

Fun=Int(Rnd()*10)+1 //rnd随机生成0.*到1的数 Fun即作为函数名，也作为接收返回值变量

if xxx Then

Exit Function //相当于return

End Function

代码规范

长行代码变为短行代码

Worksheets(“sheet”) _ //下划线前的空格不能省

.Range(“a1”) .Font.Bold=True

短变长

Dim a%,b%:a=1:b=2 //就是用:代替了C的;

注释

• 用单引号
• 用Rem 放在语句前告诉编译器这行是注释

常用对象

• Application
  • 代表Excel
• Workbook
  • 代表工作簿
• Worksheet
  • 代表工作表
• Range
  • 代表单元格，可以是一个Cell也可以是一个单元格区域

Cells.ClearContents //清除表中所有数据

Application.ScreenUpdating=False //相当于关闭实时更新，加快速度，让人觉得牛逼

执行完操作了要让其恢复为True

Application.DisplayAlerts=False //取消警告框

Application.EnableEvent=False //不触发操作事件 通过 先False再True能让死循环的操作只执行一次

Target.Offset(1, 0).Select //选中单元格时，再选中下一行

在VBA中使用在表格中用的函数

• mycount=Application.WorksheetFunction.CountIf(Range(“A1:B50”),">1000")
• 返回在指定匹配中数值大于1000的表格数

特殊对象不用一级一级从Application往下引用才能使用

• Application.Selection.Value=1000 //当前选中对象
• Selecttion.Value=1000
• ActiveCell //当前活动单元格
• ActiveChart //当前工作簿中活动的图表
• ActiveSheet
• ActiveWindow
• ActiveWorkbook
• Charts //当前活动工作簿中所有的图表 工作表
• Selections //当前活动工作簿中所有选中的对象
• Sheets
• Worksheets
• Workbooks //当前所打开的工作簿

用索引来引用工作薄

• Workbooks.Item(3)
• Workbooks(3)

用名字引用工作薄

• Workbooks(“book1.xls”)
• 就这么记，要加扩展名

ThisWorkbook代表所在的工作薄

Workbooks.Add xlWBATChart //指定插入一个新的图表工作表到工作簿中

Workbooks.Open Filename:=“F:\book1.xls” //打开F盘的文件 这个等号前的:用得我难受

• 参数名和参数值之间用:=连接

Workbooks(“book1”).Activate

ThisWorkbook.save //保存代码所在的工作簿

Workbooks.SaveAs Filename:=“F:\book1.xls” //另存并关闭原文件，打开 新文件

xxx.SaveCopyAs xxxx //继承保留在原文件，不打开另存的新文件

xxx.Close //关闭

Workbooks(“book1”).Close savechanges:=True //关闭并保存修改

• Workbooks(“book1”).Close True //简写

工作表

• 引用工作表

• Worksheets.Item(1)

• Worksheets(1)

• Worksheets(“Sheet1”)

• Sheet1.Rangexxxxxx //在VBE中查看Sheet1这个CodeName即可

• 插入工作表

  • Worksheets.Add after:=Worksheets(1),Count:=3 //在表1后插入3张表

• 改表名

  • Worksheets(2).Name=“gggg”
  • ActiveSheet.Name=“gggg”
  • Worksheets.Add(beore:=Worksheeets(1)).Name=“ggggg” //在新建时就指定表名

• 删表

  • Worksheets(“Sheet1”).Delete

• 激活表

  • Worksheets(“Sheet1”).Activate

  • Worksheets(“Sheet1”).Select

    • 工作表隐藏时，不能Select，Activate一次只能选中一张表,而Select能选中未隐藏的多张表

Range(“A1:A10,A4:E6,C3:D9”).Select //一次选中多个单元格 取并集

Range(“B1:B10 A4:D6”).Value = 1 //取交集

• 区别就是一个 逗号，一个空格

ActiveSheet.Rows(“3:5”).Select //3到5行

ActiveSheet.Rows(“3:3”).Select //3行

ActiveSheet.Columns(“F:G”).Select //选中F到G列

Union就是将不连续的单元格粘在一起，可以同时对其进行操作

Range(“C5:D6”).Offset(2,3).Select //偏移啊，还用讲

Range(“A1”).Resize(5,6).Select //重新选定大小

ActiveSheet.UsedRange.Select //选中工作表中已经使用的单元格区域,有空行空列

Range(“B5”).CurrentRegion.Select //相当于选中B5单元格后按F5键

定位当前区域得到的单元格区域

Range(“C5”).End(xlUp).Select

• xlToLeft
• xlToRight
• xlUp
• xlDown //相当于按Ctrl+向下

---

这个就牛逼坏了

ActiveSheet.Range(“A65536”).End(xlUp).Offset(1,0).Value=“xxxxx” //在A列最后一个单元格按上方向键得到列最后一个非空单元格，往下偏移开始写入数据

A列不能全空，不然是在A2写的，因为往下偏移了一个位置

Dim xrow As Long

xrow=ActiveSheet.UsedRange.Rows.Count+1

Cells(xrow,"A).Value="xxx

Dim xrow As Long

xrow=Range(“A1”).CurrentRegion.Rows.Count+1

Cells(xrow,“A”).Value=“xxxxx”

---

不确定复制源单元格数量时，只用指定一个单元格作为目标区域的最左上角单元格，格式也一起复制了

Range(“A1”).CurrentRegion.Copy Range(“G1”)

Range(“F1:F10”).Value = Range(“G1:G10”).Value //单纯复制值

Range(“B5”).Delete Shift:=xlToLeft //删除B5，删除后右侧单元格左移

Range(“B5”).Delete Shift:=xlUp //删除B5，删除下方单元格上移

Range(“B5”).EntireRow.Delete //删除B5所在的行

Range(“B5”).EntireColumn.Delete //删除B5所在的列

203页

指定名称

• 给单元格区域指定一个名称

• ActiveWorkbookNames.Add Name:=“data” , RefersToR1C1: =“Sheet1! R5C[-2]”

• 这个指定名称有点用吧，重要的是这里用的表名称定位要学学

• 首先是CodeName

  • Sheetq1
  • 后面跟了一个!

• 它的引用

• RefersToR xxxx C xxxx

  • R后面跟行数
  • C 后面跟列数

• []

  • 没有中括号为绝对引用
  • 加了中括号为相对引用

• 另一种写法

• ActiveWorkbook,Names.Add Name:=“data” , RefersTo := “=Sheet1! $B$4”

• 注意引用中加了=

• 使用$是绝对引用

• 不加$就是相对引用

• 最简单的写法

• Rnge(“A1:C10”).Name=“data”

你说用union添加了一堆区域再加上名字，是不是就能简便的操作他们了

• ActiveWorkbook.Names(“data”).Name="姓名“
• 用名称引用再修改自身的名字
• ActiveWorkbook.Names(“姓名”).RefersTo=" 张三”
  • 更改名称的值

给单元格添加批注

• Range(“R5”).AddComment Text:=“这是批注”

• 已经有批注了，再里面添加批注会出错，要判断一下

• If Range(“R5”).Comment Is Nothing Then

• ​ xxxx

• End if

• Range(“R5”).Comment.Viible=False //隐藏批注

• Range(“R”).Comment.Delete //删除批注

设置字体

• With Range(“A1:L1”).Font
  • .Name=“宋体”
  • .Size=12
  • .Bold=True
  • .Italic=True
  • .Underline=xlUnderlineStyleDouble
• End With

设置底纹

• Range(“A1:L1”).Interior.Color=RGB(233,233,233)

设置边框

• With Range(“A1”).CurrentRegion.Borders
  • .LineStyle=xlContinuous //设置单线边框
  • .Color=RGB(0,0,255)
  • .Weight=xlHairline //设置边框线条样式
• End With

创建一个工作簿

Dim Wb As Workbook, sht As Worksheet    //定义一个workbook对象和一个worksheet对象
Set Wb = Workbooks.Add					//新建一个工作簿 
Set sht = Wb.Worksheets(1)				//
With sht
.Name = "花名册"						//修改第一张工作表的标签名称 
.Range("A1:D1") = Array("序号", "姓名", "性别", "出生年月")   //设置表头
End With

Wb.SaveAs ThisWorkbook.Path & "\员工花名册.xls"    //保存新建的工作簿到本路径中 
ActiveWorkbook.Close			//关闭新建的工作簿

工作簿中有需要的工作表就提前到第一个，没有就新建

Dim sht As Worksheet
For Each sht In Worksheets
    If sht.Name = "一年级" Then
        sht.Move before:=Worksheets(1)
        Exit Sub
    End If
    
Next
Worksheets.Add(before:=Worksheets(1)).Name = "一年级"

判断目录中的是否有需要的xls文件

Dim fil As String
fil = ThisWorkbook.Path & "\要找的文件名.xls"
If Len(Dir(fil) > 0) Then     //如果文件存在，Dir函数返回文件名 
    //有工作簿
Else
	//没有工作簿
End If

向未打开的工作簿中录入数据

Dim wb As String, xrow As Integer, arr As Variant
wb = ThisWorkbook.Path & "\要打开文件名.xls"
Workbooks.Open (wb)           //先打开才能写
With ActiveWorkbook.Worksheets(1)    //选中第一张表
xrow = Range("A1").CurrentRegion.Rows.Count + 1    //向第一个空行写数据  
arr = Array(xrow - 1, "张三", "女")         //写数据到数组  
.Cells(xrow, 1).Resize(1, 3) = arr				//正式写数据
End With
ActiveWorkbook.Close (True)     //关闭工作簿并保存修改

隐藏活动工作表外的所有工作表

Dim sht As Worksheet
For Each sht In Worksheets
    If sht.Name <> ActiveSheet.Name Then
        sht.Visible=xlSheetVeryHidden    //深度隐藏,右键取消隐藏无用
    End If
    
Next

根据班级名新建不同的班级工作表

Dim i As Integer, sht As Worksheet
i = 2										//第一条记录的行号为2
Set sht = Worksheets("成绩表")
Do While sht.Cells(1, "C") <> ""          //1C是班级名所在的列
    Worksheets.Add after:=Worksheets(Worksheets.Count)    //在所有表后添加工作表 
    ActiveSheet.Name = sht.Cel(i, "C").Value     //更改工作表的标签名称
    i = i + 1							//行号增加1
Loop

根据班级名新建不同的班级工作表，预防重复字段

Dim i As Integer, sht As Worksheet
i = 2										//第一条记录的行号为2
Set sht = Worksheets("成绩表")
Do While sht.Cells(1, "C").Value <> ""          //1C是班级名所在的列
	On Error Resume Next           //出错继续,下面的可能会出错
		If worksheets(sht.Cells(i,"C").Value) Is Nothing Then        //判断有没重复添加
			Worksheets.Add after:=Worksheets(Worksheets.Count)    //在所有表后添加工作表 
    		ActiveSheet.Name = sht.Cel(i, "C").Value     //更改工作表的标签名称
    	End If
    
    i = i + 1							//行号增加1
Loop

根据班级名分类数据到不同的表中

Dim i As Long, bj As String, rng As Range
i = 2
bj = Cells(i, "c").Value
Do While bj <> ""
    Set rng = Worksheets(bj).Range("A65536").End(xlUp).Offset(1, 0)
    Cells(i, "A").Resize(1, 7).Copy rng     //将记录复制到相应的工作表中 
    i = i + 1
    bj = Cells(i, "C").Value
Loop

GetObject(路径名 \文件名)

• 相当于打开一个xlsx文件，可以把他赋值给workbook变量
• 就是得到了一个就能取数据 的工作簿

Dim FileName As String

FileName=Dir //取得其他文件名,这个Dir就很迷

为工作表建立目录

Rows("2:65536").ClearContents     //从第2行开始全部清除了
Dim sht As Worksheet, irow As Integer
irow = 2
For Each sht In Worksheets
    Cells(irow, "A").Value = irow - 1       //对A列赋值
    Debug.Print irow
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(irow, "B"), Address:="", _
    SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name       //新建一个超链接
    irow = irow + 1
Next

Worksheet事件列表

• Activate
• BeforeDoubleClick
• BeforeRightClick
• Calculate //重新计算工作表之后发生
• Change
• Deactivate //工作表由活动工作表变为不活动工作表时发生
• FollowHyperlink //单击工作表由活动工作表变为不活动工作表时发生
• PivotTableUpdate //在工作表中更新数据透视表之后发生
• SelectionChange //工作表中所选内容发生更改时发生

Workbook事件

• BeforeClose

  If MsgBox("你确定要关闭工作簿吗?",vbYesNo)=vbNo Then
  	Cancel=True     //取消关闭
  End If
  
  

• Activate

• AddinInstall

• AddinUninstall

• AfterXmlExport

• AfterXmlImport

• BeforePrint

• BeforeSave

• BeforeXmlExport

• BeforeXmlImport

• Deactivate

• NewSheet

• Open

• PivotTableOpenConnection //在数据透视表连接打开之后发生

• PivotTableCloseConnection //在数据透视表连接关闭之后发生

• SheetActivate

• SheetBeforeDoubleClick

• SheetBeforeRightClick

• SheetCalculate //在重新计算工作表时或在图表 上绘制 更改的数据之后发生

• SheetChange //当更改了任何工作表中单元格时发生

• SheetDeactivate //当工作表从活动工作表变为不活动工作表时发生

• SheetFollowHyperlink //当单击工作簿的任何超链接时发生

• SheetPivotTableUpdate //在更新数据透视表的工作表后发生

• SheetSelectionChange //当任意工作表上的选定区域发生更改时发生 ，在图表工作表上的选定区域上发生改变时不会触发

• Sync //当作为文档工作区一部分的工作簿的本地副本与服务器上的副本进行同步时发生

• WindowActivate //在激活任意工作簿窗口时发生

• WindowDeactivate //当任意工作簿窗口由活动窗口变为不活动窗口时发生

• WindowResize //在调整任意窗口的大小时发生

在按钮上可以定义MouseMove之类的事件

键盘事件

• Application.OnKey “+e” “test_sub”
  • +e
    • 表示按下 Shift+e
  • test_sub
    • 这个是要运行的程序过程名称的字符串

定时事件

• Application.OnTime Now()+TimeValue(“01:00:00”), “Test_sub”
• Now()
  • 返回当前系统时间
• TimeValue(“01:00:00”)
  • 表示1小时的时间
• “Test_sub"
  • 程序名称

要使用这些定义的键盘定时事件，就在工作簿Workbook Open的函数里调用即可，这样才能生效

Private Sub Worksheet_Change(ByVal Target As Range)
//如果更改的单元格不是C列第3行以下的单元格或更改的单元格个数大于1时不执行
	If Application.Intersect(Target,Range("C3:C65536")) Is Nothing Or Target.Count >1 Then
		Exit Sub
	End if
	Dim i As Interger 
	i=3							//更改的是第三行第I列开始的单元格
	Do While Cells(i,"I").Value <> ""               //同工作表中有一个参照表
		If UCase(Target.Value)=Cells(i,"I").Value Then     //输入的是参数表中相同的大写内容时触发
			Application.EnableEvents=False  //避免重复触发
            Target.Value=Cells(i,"I").Offset(0,1).Value
            Target.Offset(0,-1).Value=Date   
            Target.Offset(0,1).Value=Cells(i,"I").Offset(0,2).Value   //从参数表中复制数据过来 
            Target.Offset(0,2).Value=Cells(i,"I").Offset(0,3).Value   //减少重复劳动
            Application.EnableEvents=True   //重新启用事件
            Exit Sub
         End If
         i=i+1
    Loop
End Sub
            
            
            

Private Sub Worksheet_SelectionChange(ByvAL Target As Range)
	Range("B3:Q22").Interior.ColorIndex=xlNone   //清除单元格里原有底纹颜色
	If Target.Count > 1 Then
		Set Target=Target.Cells(1)    //当选中的单元格个数大于1时，重新给Target赋值
	End If
	
	//当选中的单元格不包含指定区域的单元格时，退出
	If Application.Intersect(Target,Range("B3:Q22")) Is Nothing Then
		Exit Sub
	End If
	
	//标识想要的单元格
	Dim rng As Range
	For Each rng In Range("B3:Q22")
		If rng.Value = Target.Value Then
			rng.Interior.ColorIndex=39
		End If
	Next
End Sub	

Private Sub Worksheet_SelectionChange(ByvAL Target As Range)
	Range("B3:Q22").Interior.ColorIndex=xlNone   //清除单元格里原有底纹颜色
	If Target.Count > 1 Then
		Set Target=Target.Cells(1)    //当选中的单元格个数大于1时，重新给Target赋值
	End If
	
	//当选中的单元格不包含指定区域的单元格时，退出
	If Application.Intersect(Target,Range("B3:Q22")) Is Nothing Then
		Exit Sub
	End If
	
	//标识想要的单元格所在的行和列
	//添加底纹颜色
	Range(Cells(Target.Row,"B"),Cells(Target.Row,"Q")).Interior.ColorIndex=39
	Range(Cells(3,Target.Column),Cells(22,Target.Column)).Interior.ColorIndex=39
End Sub	

Sub otime()
	Application.OnTime Now()+TimeValue("00:01:00"), "WbSave"   //设置一段时间后执行保存函数 
End Sub

Sub WbSave()
	ThisWorkbook.Save			//保存
	Call otime					//继续去定时启动，相当于陷入死循环
End Sub

Private Sub Workbook_Open()
	Call otime     //打开工作簿自动运行otime
End

错误处理

• On Error Goto a

  Sub test()
  	On Error GoTo  a     //失败跳转
  	Worksheets("abc").Select
  	Exit Sub
  	a: xxxx
  End Sub

• On Error Resume Next

  Sub test()
  	On Error Resume Next     //忽略该运行代码之后出现的运行时错误
  	Worksheets("abc").Select     //这条有错就跳过
  	Exit Sub
  End Sub

释放内存之类的语法

Dim rng As Range
Set rng=Worksheets(1).Range("A1:D199")

xxxxx
Set rng=Nothing					//释放他，别占内存

//花了2.52秒
Sub IputTxt()
	Dim start  As Double
	start =	Timer				//取得从午夜开始到程序运行时经过的秒数
	Dim i As Long
	For  i =1 to 655356
		Cells(i,"A").Value=1
	Next
	MsgBox "程序运行的时间是" & Format (Timer-start,"0.00")  & "秒"
End Sub

花了0.09秒  提升28.1倍
Sub IputTxt()
	Dim start  As Double
	start =	Timer				//取得从午夜开始到程序运行时经过的秒数
	Dim i As Long,arr(1 To 65536) as Long
	For  i =1 to 655356
		arr(i)=i
	Next
	Range("A1:65536").Value=Application.WorksheetFunction.Transpose(arr)
	MsgBox "程序运行的时间是" & Format (Timer-start,"0.00")  & "秒"
End Sub

//省转置
Sub IputTxt()
	Dim start  As Double
	start =	Timer				//取得从午夜开始到程序运行时经过的秒数
	Dim i As Long,arr(1 To 65536,1 To 1) as Long
	For  i =1 to 655356
		arr(i,1)=i
	Next
	Range("A1:65536").Value=arr
	MsgBox "程序运行的时间是" & Format (Timer-start,"0.00")  & "秒"
End Sub