VBA_公式02

Sub chuangjianbiao()
    Dim iCol
    Dim sht As Worksheet
    Dim  i, j, k, f, s, iCol As Integer
    irow = Sheet1.Range("a65536").End(xlUp).Row
    f = 2
    iCol = InputBox("根據第幾列分表?")
    '判斷輸入信息是否正確
    For s = 1 To f
        'IsNumeric(iCol)判斷檢測變量是否爲數字或數字字符串如果是就返回true
        If VBA.IsNumeric(iCol) = False Or iCol < 0 Or iCol > 6 Then
            f = f + 1
            iCol = InputBox("輸入的不對請重新輸入！")
        Else
        Exit For
        End If
    Next
    '遍歷工作薄刪除其他表
    Application.DisplayAlerts = False   '關掉警告
    For Each sht In Sheets
        If sht.Name <> "數據" Then
            sht.Delete
        End If
    Next
    Application.DisplayAlerts = True
    '拆分表
    For j = 2 To irow 
        k = 0
        For i = 1 To Sheets.Count
            '如果某表名等於表1第2行第幾列單元格的值，標識下不再新建表
            If Sheets(i).Name = Sheet1.Cells(j, iCol) Then
                k = k + 1
            End If
        Next
        
        If k = 0 Then
            Sheets.Add after:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Sheet1.Cells(j, iCol)
        End If
    Next
    
    
    '拷貝表1的數據
    For i = 2 To Sheets.Count
        Sheet1.Range("a1:f" & irow).AutoFilter Field:=iCol, Criteria1:=Sheets(i).Name
        Sheet1.Range("a1:f" & irow).Copy Sheets(i).Range("a1")
    Next
    Sheet1.Range("a1:a" & irow).AutoFilter
    Sheet1.Select
End Sub