根据某列数据拆分生成文件，在windows运行正常，而在Mac运行出错

jmtang

根据某列数据拆分生成文件，在windows运行正常，而在Mac运行出错

jmtang

Sub chaifenshuju()

Dim sht As Worksheet
Dim k As Integer, i As Integer, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer
Dim m As String

l = InputBox("请输入你要按哪列分") '拆分数据列

irow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '数据最后一行

'创建表
For i = 2 To irow
    k = 0
    For Each sht In Sheets
        If sht.Name = Sheets("Sheet1").Cells(i, l).Value Then
            k = 1
            Exit For ' 找到了相同的工作表名就不用继续查找了
        End If
    Next
   
    If k = 0 Then
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = Sheets("Sheet1").Cells(i, l).Value
    End If
Next

'拷贝数据
For j = 2 To Sheets.Count
    If Not SheetExists(Sheets(j).Name) Then Exit Sub ' 如果工作表不存在则退出
   
    Sheets("Sheet1").AutoFilterMode = False ' 清除之前的筛选器
    Sheets("Sheet1").Range("A1:Ag" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
    Sheets("Sheet1").Range("A1:Ag" & irow).Copy Sheets(j).Range("A1")
Next

'另存文件
Dim sh As Worksheet
m = ThisWorkbook.Path
For Each sh In Sheets
    sh.Columns.AutoFit
    sh.Range("A1").Select
    Selection.NumberFormat = "#"
    sh.Copy
    ' 保存文件时省略文件格式参数，让 Excel 自动确定
    ActiveWorkbook.SaveAs Filename:=m & "/" & sh.Name & "班高三第二学期第一次模拟考试成绩册.xlsx"
    ActiveWorkbook.Close savechanges:=False
Next

'删除表
Application.DisplayAlerts = False

Dim sht1 As Worksheet

If Sheets.Count > 1 Then
    For Each sht1 In Sheets
        If sht1.Name <> "Sheet1" Then
            sht1.Delete
        End If
    Next
End If

Application.DisplayAlerts = True

MsgBox "数据拆分成功,老汤开心一点哟!"

End Sub

shiruiqiang

mac不支持字典