# 函数

## Application主程序对象

application.displayalsert=false 表示不要弹窗

## Open 打开文件

eg ：

application screenupdating=false//不要屏幕更新
Workbooks. Open Filename:="d:\data\1.xlsx"
activeworkbook.sheets(1).range("a1") = "lala"//表示打开当前文件输入的标记
activeworkbook.save
activeworkbook.close
application.displayalsert=true


eg:

Sub one()
ActiveWorkbook.Sheets(1).Range("a1") = "llll"
ActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\22.xlsx"
ActiveWorkbook.Close

End Sub



range（“范围”）
**Save/Save as 保存工作簿
Close关闭工作簿
Select(选中)
Delete(删除)
Copy(复制)
ClearContents(清空)
Value(值) Text(内容文字)
Row(行号) Column(列号)
Entirerow单元格所在整行 **

## Msgbox和Inputbox窗口函数

Sub chuan()
Msgbox "你好"
m = InputBox("请输入第" & m & "例")
End Sub


# 练习

## 拆分表存储成文件

Sub chaifen()
Dim sht As Worksheet
Dim i As Integer
For Each sht In Sheets

sht.Copy
ActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\" & sht.Name & ".xlsx"
ActiveWorkbook.Close

Next
End Sub



//删除空格，填充
Sub shaixuan()
Dim sht As Worksheet
Dim i As Integer

For Each sht In Sheets
For i = 100 To 2 Step -1
If sht.Cells(i, 4) = "" Then
sht.Range("d" & i).EntireRow.Delete
End If

If sht.Cells(i, 2) = "理工" Then
sht.Cells(i, 3) = "lg"
ElseIf sht.Cells(i, 2) = "文科" Then
sht.Cells(i, 3) = "wg"
Else
sht.Cells(i, 3) = "ck"
End If

If sht.Cells(i, 5) = "男" Then
sht.Cells(i, 6) = "先生"
Else
sht.Cells(i, 6) = "女士"
End If
Next

Next

End Sub

//拆成文件
Sub chai()
Dim sht As Worksheet
For Each sht In Sheets
sht.Copy
ActiveWorkbook.SaveAs Filename:="C:\Users\zsnzd\Desktop\excel\第四节\" & sht.Name & ".xlsx"
ActiveWorkbook.Close
Next
End Sub



## 利用筛选分离表格内容

**注意
1、end后面的row
2、k是整数型
3、range（“a1：f”&k）
4、copy后面直接加sht.单元格
5、Criteria1:="=" 这里是one
**

Sub 用筛选拆分()
Dim i As Integer
Dim sht As Worksheet

i = Sheet1.Range("a65535").End(xlUp).Row
For Each sht In Worksheets
If sht.Name <> 数据 Then

Sheet1.Range("a1:f" & i).AutoFilter field:=4, Criteria1:="=" & sht.Name
Sheet1.Range("a1:f" & i).Copy sht.Range("a1")

End If
Next

Sheet1.Range("a1:f" & i).AutoFilter
End Sub


## 按照a1建表（避免重复名字）

**注意：
1、i表示对行的循环整数
2、k表示布尔值判断作用
**

Sub bimian()
Dim sht As Worksheet
Dim i As Integer
Dim k As Integer
For i = 1 To Sheet1.Range("a65536").End(xlUp).Row
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range("a" & i) Then
k = 1
End If
Next
If k = 0 Then
Sheets(Sheets.Count).Name = Sheet1.Range("a" & i)
End If
Next
End Sub


## 填充数据到指定表格里

Sub chai()
Dim sht As Worksheet
Dim k As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
For Each sht In Sheets
If sht.Name <> 数据 Then
Sheet1.Range("a1:f" & k).AutoFilter field:=4, Criteria1:="=" & sht.Name
Sheet1.Range("a1:f" & k).Copy sht.Range("a1")
Next
Sheet1.Range("a1:f" & k).AutoFilter
End Sub


## 将数据表单元格创建分表再填充数据

Sub chai()
Dim sht As Worksheet
Dim k, i, j As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
'拆分
For i = 2 To k
j = 0
For Each sht In Worksheets
If sht.Name = Sheet1.Range("d" & i) Then
j = 1
End If
Next
If j = 0 Then
Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)
End If
Next
'填数据
For Each sht In Worksheets
If sht.Name <> 数据 Then
Sheet1.Range("a1:f" & k).AutoFilter field:=4, Criteria1:="=" & sht.Name
Sheet1.Range("a1:f" & k).Copy sht.Range("a1")
End If
Next

Sheet1.Range("a1:f" & k).AutoFilter
End Sub


# 综合训练

## 利用窗口函数吧上面的动作重新来一遍

Sub chai()
Dim sht As Worksheet
Dim k, i, j As Integer
k = Sheet1.Range("a65536").End(xlUp).Row
Msgbox "你好"
m = InputBox("请输入一个" & m & "列")
'拆分
For i = 2 To k
j = 0
For Each sht In Worksheets
If sht.Name = Sheet1.Range("d" & i) Then
j = 1
End If
Next
If j = 0 Then
Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)
End If
Next
'填数据
For Each sht In Worksheets
If sht.Name <> 数据 Then
Sheet1.Range("a1:f" & k).AutoFilter field:=m, Criteria1:="=" & sht.Name
Sheet1.Range("a1:f" & k).Copy sht.Range("a1")
End If
Next

Sheet1.Range("a1:f" & k).AutoFilter
End Sub



## 把分表内容整合到sht1

1、清空内容要指定range范围

Sub hebing()
Dim i, j As Integer   //i是数据源表的最后一行，j是目标表(数据表)的最后一行
Dim sht As Worksheet

//先要删除所有数据
Sheet1.Range("a1:f65536").ClearContents

//复制表头
Sheet2.Range("a1:f1").Copy Sheet1.Range("a1")

//复制数据
For Each sht In Sheets
If sht.Name <> "数据" Then
i = sht.Range("a65536").End(xlUp).Row
j = Sheet1.Range("a65536").End(xlUp).Row

sht.Range("a2:f" & i).Copy Sheet1.Range("a" & j + 1)
End If
Next
End Sub



05-01
05-16 1万+
12-05 4220
04-18 2万+
05-27 2680
11-29
12-30 9175
02-08 4987
12-20 6825
11-04 1万+
07-23 1082
©️2020 CSDN 皮肤主题: 数字20 设计师:CSDN官方博客