美文网首页excel的一些小技巧教程
练习-拆分复制各表的优化

练习-拆分复制各表的优化

作者: A_rrow | 来源:发表于2019-07-21 11:20 被阅读0次

    在刚开始弹出对话框要拆分哪列时,需要考虑输入的可能不是数字或者输入的数字不再指定范围的问题,本次优化通过函数公式解决这个问题

    Sub t()
    
    Dim sht As Worksheet
    
    '先判断输入的是否时数字'
    l = InputBox("请问要按哪列拆分")
    If VBA.Information.IsNumeric(l) = False Or l < 1 Then
        Exit Sub
    End If
    
    l = Val(l)
    
    '清空表'
    Application.DisplayAlerts = False
    If Sheets.Count > 1 Then
        For Each sht In Sheets
            If sht.Name <> 数据 Then
                sht.Delete
            End If
        Next
    End If
    Application.DisplayAlerts = True
    
    '拆分表'
    irow = Sheet1.Range("a65536").End(xlUp).Row
    For i = 2 To irow
        k = 0
        For Each sht In Sheets
            If sht.Name = Sheet1.Cells(i, l) Then
                k = 1
            End If
        Next
        If k = 0 Then
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
        End If
    Next
    
    '复制数据'
    For j = 2 To Sheets.Count
         Sheet1.Range("a1:f" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
         Sheet1.Range("a1:f" & irow).Copy Sheets(j).Range("a1")
    Next
    
    Sheet1.Range("a1:f" & irow).AutoFilter
    
    Sheet1.Select
    
    MsgBox "处理完毕啦"
        
    End Sub
    

    主要语法点

    1. IsNumeric判断是否为数字
    2. val 转换成数值
    If VBA.Information.IsNumeric(l) = False Or l < 1 Then
       Exit Sub
    End If
    

    相关文章

      网友评论

        本文标题:练习-拆分复制各表的优化

        本文链接:https://www.haomeiwen.com/subject/rxlmlctx.html