总表成绩按班生成分表

shuiman

大家帮我分析一下，为什么这样会出错。改成下面的就可以。第一个班可以生成101，第二个班就不会建立了。判断desSheet不为nothing，想不明白。改在以下代码则全部正确，想不明白

3190496160

先把文件中的所有工作表名称复制给一个字典，然后再判断一下要生成的工作表名称在字典中是否存在，不存在则新建，或者，运行代码是，代码先删除出总表以外的其他工作表，就不需要判断了呀

everbest2015

错误归零恢复的不是时候

wengjl

wengjl

Sub 生成分班表()
    ' 2024-9-19
    Application.DisplayAlerts = False
    Dim Arr, Brr(1 To 10, 1 To 2), d, Crr(5)
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To 5
      Crr(i) = Sheet1.Cells(1, i).Value
    Next i
    Arr = Sheet1.[A2].CurrentRegion
    For i = 2 To UBound(Arr)
      ss = Arr(i, 3)
      If Not d.exists(ss) Then
        m = m + 1
        d(ss) = m
        Brr(m, 1) = ss
      End If
    Next i
    For j = 1 To m
      bmc = CStr(Brr(j, 1))
      bj = Brr(j, 1)
      For i = 1 To Worksheets.Count            ' 按工作表数量循环
        If Worksheets(i).Name = bmc Then       ' 通过循环判断，来完成指定表名是否存在的查找
          Worksheets(i).Delete                 ' 删除表
          Exit For
        End If
      Next i
      Sheets.Add.Name = bmc                        ' 增加表，并起名为 BMC 变量中的值
      Sheets(bmc).Move after:=Sheets(Sheets.Count) ' 将刚新增的表移动到最右侧
      For k = 1 To 5
        Sheets(bmc).Cells(1, k).Value = Crr(k)
      Next k
      x = 2
      For m = 2 To UBound(Arr)
        If Arr(m, 3) = bj Then
          For k = 1 To 5
            Sheets(bmc).Cells(x, k).Value = Arr(m, k)
          Next k
          x = x + 1
        End If
      Next m
    Next j
    Application.DisplayAlerts = True
End Sub

粘贴到模块中，即可

shuiman

wengjl 发表于 2024-9-19 16:12
Sub 生成分班表()
    ' 2024-9-19
    Application.DisplayAlerts = False

太牛了，谢谢！！！