请问老师，以下程序是计算各科成绩在班级的名次和全校的名次、等级，能正常后执行，但保存后再打开结果没有了，是什么原因？

Tables("成绩总表").StopRedraw
Dim cs() As String ={"语文_高一","语文_高二","数学_高一","数学_高二","英语_高一","英语_高二","物理_高一","物理_高二","化学_高一","化学_高二","政治_高一","政治_高二","历史_高一","历史_高二","地理_高一","地理_高二","技术_高一","技术_高二","生物_高二","总分"}
Dim t As Table = Tables("成绩总表")
For Each c As String In cs
    If t.DataTable.DataCols.Contains(c & "_班名")=False Then
        t.DataTable.DataCols.Add(c & "_班名", Gettype(Integer))
        t.cols(c & "_班名").Move(t.cols(c).Index+1)
    End If
    If t.DataTable.DataCols.Contains(c & "_校名")=False Then
        t.DataTable.DataCols.Add(c & "_校名", Gettype(String))
        t.cols(c & "_校名").Move(t.cols(c).Index+2)
    End If
    If t.DataTable.DataCols.Contains(c & "_等级")=False Then
        t.DataTable.DataCols.Add(c & "_等级", Gettype(String))
        t.cols(c & "_等级").Move(t.cols(c).Index+3)
    End If
    t.cols(c).Caption = c & "_分数"
Next

Dim bjs As List(Of String) = DataTables("成绩总表").GetValues("班级","[班级] Is Not NULL")
Dim Count As Integer
Dim ColNames() As String ={"语文_高一","语文_高二","数学_高一","数学_高二","英语_高一","英语_高二","物理_高一","物理_高二","化学_高一","化学_高二","政治_高一","政治_高二","历史_高一","历史_高二","地理_高一","地理_高二","技术_高一","技术_高二","生物_高二","总分"}
Dim TotalName As String
Dim denji As String
For Each ColName As String In ColNames
    
    \'以下设置学科成绩按全校排名和等级
    
    Dim drss As List(of DataRow)=DataTables("成绩总表").Select("", Colname & " DESC ")
    count=0
    TotalName = ColName & "_校名"
    denji=Colname & "_等级"
    For n As Integer = 0 To drss.Count - 1 \'遍历所有行
        Count = Count + 1
        If n > 0 AndAlso drss(n)(Colname) = drss(n-1)(Colname) Then \'如果总分和上一行相同
            drss(n)(Totalname) = drss(n-1)(Totalname) \'则排名等于上一行
        Else
            drss(n)(Totalname) =count \'设置排名
        End If
        If drss(n)(Totalname)<=drss.Count *0.15 Then
            drss(n)(denji)="A"
        ElseIf drss(n)(Totalname)<=drss.Count *0.45 Then
            drss(n)(denji)="B"
        ElseIf drss(n)(Totalname)<=drss.Count *0.75 Then
            drss(n)(denji)="C"
        ElseIf drss(n)(Totalname)<=drss.Count *0.95 Then
            drss(n)(denji)="D"
        Else
            drss(n)(denji)="E"
        End If
    Next
    
    \'以下设置学科成绩按班级排名
    For i As Integer = 0 To bjs.Count -1
        Dim drs As List(Of DataRow) = DataTables("成绩总表").Select("[班级] = " & bjs(i), ColName & " DESC")
        Count = 0
        TotalName = ColName & "_班名"
        For n As Integer = 0 To drs.Count - 1
            Count = Count + 1
            If n > 0 AndAlso drs(n)(ColName ) = drs(n-1)(ColName) Then
                drs(n)(TotalName ) = drs(n-1)(TotalName )
            Else
                drs(n)(TotalName ) = Count
            End If
        Next
    Next
Next
Tables("成绩总表").Sort = "总分 DESC"
Tables("成绩总表").ResumeRedraw
此主题相关图片如下：截图20160506150810.png

 生成以后，你把表格保存成excel文件，然后删除这个表，然后导入excel文件，然后把下面的代码删除

Dim cs() As String ={"语文_高一","语文_高二","数学_高一","数学_高二","英语_高一","英语_高二","物理_高一","物理_高二","化学_高一","化学_高二","政治_高一","政治_高二","历史_高一","历史_高二","地理_高一","地理_高二","技术_高一","技术_高二","生物_高二","总分"}
Dim t As Table = Tables("成绩总表")
For Each c As String In cs
    If t.DataTable.DataCols.Contains(c & "_班名")=False Then
        t.DataTable.DataCols.Add(c & "_班名", Gettype(Integer))
        t.cols(c & "_班名").Move(t.cols(c).Index+1)
    End If
    If t.DataTable.DataCols.Contains(c & "_校名")=False Then
        t.DataTable.DataCols.Add(c & "_校名", Gettype(String))
        t.cols(c & "_校名").Move(t.cols(c).Index+2)
    End If
    If t.DataTable.DataCols.Contains(c & "_等级")=False Then
        t.DataTable.DataCols.Add(c & "_等级", Gettype(String))
        t.cols(c & "_等级").Move(t.cols(c).Index+3)
    End If
    t.cols(c).Caption = c & "_分数"
Next

大红袍老师，如果直接用菜单中的导出功能，再导入的话，多层表头就没有了。

变成这样了：

此主题相关图片如下：截图20160506212559.png

另外我发现只要在原表基础上执行以下程序自动插入列的操作，如下图，就无法保存了。

 Tables("成绩总表").StopRedraw
Dim cs() As String ={"语文_高一","语文_高二","数学_高一","数学_高二","英语_高一","英语_高二","物理_高一","物理_高二","化学_高 一","化学_高二","政治_高一","政治_高二","历史_高一","历史_高二","地理_高一","地理_高二","技术_高一","技术_高 二","生物_高二","总分"}
Dim t As Table = Tables("成绩总表")
For Each c As String In cs
    If t.DataTable.DataCols.Contains(c & "_班名")=False Then
        t.DataTable.DataCols.Add(c & "_班名", Gettype(Integer))
        t.cols(c & "_班名").Move(t.cols(c).Index+1)
    End If
    If t.DataTable.DataCols.Contains(c & "_校名")=False Then
        t.DataTable.DataCols.Add(c & "_校名", Gettype(String))
        t.cols(c & "_校名").Move(t.cols(c).Index+2)
    End If
    If t.DataTable.DataCols.Contains(c & "_等级")=False Then
        t.DataTable.DataCols.Add(c & "_等级", Gettype(String))
        t.cols(c & "_等级").Move(t.cols(c).Index+3)
    End If
    t.cols(c).Caption = c & "_分数"
Next

 哦，是这样啊，但是下面动态增加列的代码执行后也是需要重启项目才能看到生成的列吧？那就得把增加列的代码和统计名次的代码分开，否则还是会提示列不存在

Dim Builder As New ADOXBuilder
Builder.Open()
With Builder.Tables("表A")
    .RenameColumn("第一列","姓名")
End With
Builder.Close()

你用seveExcel的方式导出成excel文件就可以了

http://www.foxtable.com/help/topics/0559.htm

嗯，导出可以保留多层表头了，那多层表头的导入也应用代码吧，为什么以下代码有错误提示：

Dim ip As New Importer
ip.SourcePath = "C:\\Users\\Public\\Desktop\\成绩总表1.xls" \'指定数据文件
ip.SourceTableName = "成绩总表1$" \'指定要导入的表
ip.NewTableName ="成绩总表1" \'导入后的表名
ip.Format = "Excel" \'指定导入格式
ip.Import()

我导出的Excel工作簿名称是“成绩总表1”，工作表也是“成绩总表1”，无论是否加"$" ，都有以下提示：