操作单元格对象2——Excel之VBA（6）

知识回顾：

cells（n,m） 行n，列m选择单元格

当前面分表用循环来做，工作量大，需要逐条扫描，可用筛选快速高效

一、AutoFilter 筛选语句

AutoFilter 

参数：

•Field:=4

•Criteria1:="一车间"

示例：Range("$A$1:$F$100").AutoFilter 

牛刀小试：数据按分列方式拆分多表

要点：

　　新建表时回避重名错误

　　使用筛选来拆分工作表

　　多表合并

 

代码过程：

'条件：表已经做好，筛选数据即可 Sub chaifen() Dim i As Integer For i = 2 To Sheets.Count 　　Sheets(1).Range("a1:f1048").AutoFilter Field:=4, Criteria1:=Sheets(i).Name 　　Sheets(1).Range("a1:f1048").Copy Sheets(i).Range("a1") Next Sheets(1).Range("a1:f1048").AutoFilter End Sub

'添加新表代码 Sub newSheet() '第一种方式 Sheets.Add after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "345" '两种方式，第二种为简写 Sheets.Add(after:=Sheets(Sheets.Count)).Name = "678" End Sub

'msgbox消息盒子弹窗 'inputbox自定义输入盒子弹窗 Sub test() ' MsgBox "Hello World" ' InputBox "你几岁了" Dim i As Integer i = InputBox("请输入你的年龄") MsgBox "原来你今年" & i & "岁了" End Sub

'条件：制表次数已确定 '新建表时回避重名错误 Sub newSheet() Dim sht As Worksheet Dim k As Integer '按某项制表，制表次数 For i = 1 To 18 　　'设置重名标识k 　　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 newsheet() Dim sht As Worksheet Dim k, i, j As Integer Dim irow As Integer '这个说的是一共多少行 '自查找制表行数 irow = Sheet1.Range("a65535").End(xlUp).Row '拆分表，制表 For i = 2 To irow 　　k = 0 　　'遍历表名，查找重名 　　For Each sht In Sheets 　　　　If sht.Name = Sheet1.Range("d" & i) Then 　　　　k = 1 　　　　End If 　　Next 　　'无重名表，制表 　　If k = 0 Then 　　　　Sheets.Add after:=Sheets(Sheets.Count) 　　　　Sheets(Sheets.Count).Name = Sheet1.Range("d" & i) 　　End If Next '进入筛选，拷贝数据 For j = 2 To Sheets.Count 　　Sheets(1).Range("a1:f" & irow).AutoFilter Field:=4, Criteria1:=Sheets(j).Name 　　Sheets(1).Range("a1:f" & irow).Copy Sheets(j).Range("a1") Next '关闭筛选 Sheets(1).Range("a1:f" & irow).AutoFilter End Sub

Sub newsheet()


Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim n As Integer '按第n列来分


n = InputBox("请输入您要分类的列号")

'删除先前分列数据
Application.DisplayAlerts = False

If Sheets.Count > 1 Then
'    For Each sht In Sheets
'        If sht.Name <> "数据" Then
''            sht.Delete
'        End If
'    Next
    For m = Sheets.Count To 2 Step -1
    '这里注意：如果正序删除，会发生越界，因为，后面的表往前走了，表号有变
         Sheets(m).Delete
    Next
End If

Application.DisplayAlerts = True

'取数据总行号
irow = Sheet1.Range("a65535").End(xlUp).Row

'拆分表
For i = 2 To irow
    k = 0
    For Each sht In Sheets
        'If sht.Name = Sheet1.Range("d" & i) Then
        If sht.Name = Sheet1.Cells(i, n) Then
            k = 1
        End If
    Next
        
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        'Sheets(Sheets.Count).Name = Sheet1.Range("d" & i)
        Sheets(Sheets.Count).Name = Sheet1.Cells(i, n)
    End If
    
Next

'进入筛选，拷贝数据
For j = 2 To Sheets.Count

    'Sheets(1).Range("a1:f" & irow).AutoFilter Field:=4, Criteria1:=Sheets(j).Name
    Sheets(1).Range("a1:f" & irow).AutoFilter Field:=n, Criteria1:=Sheets(j).Name
    Sheets(1).Range("a1:f" & irow).Copy Sheets(j).Range("a1")

        

Next
'关闭筛选
Sheets(1).Range("a1:f" & irow).AutoFilter

Sheets(1).Select
MsgBox "分列已处理完成，牛逼不"


End Sub

续：