【excel vba】拆分表格

函数

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

Add 新建工作簿

eg:

Sub one()
Workbooks.Add
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单元格所在整行 **

Merge合并

AutoFilter(自动筛选)

Offset 偏移

新建表时回避重名错误

Msgbox和Inputbox窗口函数

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

练习

拆分表存储成文件

注意i容易出错

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
Application.DisplayAlerts = True
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
Application.DisplayAlerts = True
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表示布尔值判断作用
3、所有表的后面建sheets.add after:=
**

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.Add after:=Sheets(Sheets.Count)
        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.Add after:=Sheets(Sheets.Count)
       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.Add after:=Sheets(Sheets.Count)
       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