[已解决]用VBA数组改写相同班级只保留一个

laoau138

用VBA数组改写相同班级只保留一个

最佳答案

月排行榜 / 总排行榜

327718098

2017-4-11 17:16

Sub ShtAdd()
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
    Dim i As Integer, sht As Worksheet
    i = 2                                  '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C") <> ""       '定义循环条件
    For Each na In Worksheets
    If na.name = sht.Cells(i, "C") Then
    GoTo s
    Else
    End If
    Next
        Worksheets.Add after:=Worksheets(Worksheets.Count)      '在所有工作表后插入新工作表
        ActiveSheet.name = sht.Cells(i, "C").Value             '更改工作表的标签名称
s:        i = i + 1                         '行号增加1
    Loop
End Sub

跳转到最佳答案楼层

327718098

Sub ShtAdd()
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
    Dim i As Integer, sht As Worksheet
    i = 2                                  '第一条记录的行号为2
    Set sht = Worksheets("成绩表")
    Do While sht.Cells(i, "C") <> ""       '定义循环条件
    For Each na In Worksheets
    If na.name = sht.Cells(i, "C") Then
    GoTo s
    Else
    End If
    Next
        Worksheets.Add after:=Worksheets(Worksheets.Count)      '在所有工作表后插入新工作表
        ActiveSheet.name = sht.Cells(i, "C").Value             '更改工作表的标签名称
s:        i = i + 1                         '行号增加1
    Loop
End Sub

laoau138

327718098 发表于 2017-4-11 17:16
Sub ShtAdd()
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
    Dim i As Integer, sht As Wor ...

用数组并且不要用goto

327718098

Sub ShtAdd()
    MsgBox "下面将根据C列的班级名新建不同的工作表。"
    Dim i As Integer, sht As Worksheet
    i = 2                                  '第一条记录的行号为2
    Set sht = Worksheets("作业")
    Do While sht.Cells(i, "C") <> ""       '定义循环条件
If Application.WorksheetFunction.CountIf(sht.Range("c2:c" & i), sht.Cells(i, "C")) <= 1 Then
        Worksheets.Add after:=Worksheets(Worksheets.Count)      '在所有工作表后插入新工作表
        ActiveSheet.Name = sht.Cells(i, "C").Value             '更改工作表的标签名称
        Else
        End If
        i = i + 1                         '行号增加1
        
    Loop
End Sub