主题：内部函数代码出错

Dim App As New MSExcel.Application
    Dim wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & f1)

 不理解你什么意思。要生成多少份新报表，肯定就要打开多少次啊。

例如，在一个EXCEL表中输入数据后另存生成新报表，这时EXCEL表不用关闭的，可以继续输入数据后另存生成新报表，直到所有报表生成后，再关闭EXCEL表。这样就不用每次生成新报表都要打开EXCE表，这是EXCEL的操作。

如果你不重新打开，导入的数据还在里面啊。

 

重新打开很费事么？有必要纠结这个东西么？如果效率低，你做个例子上来看看到底有多慢。

导入的数据还在里面啊，就是这个问题？有无有办法解决？可以提高效率一倍多。

 打开excel文件，耗时真心不多啊，你自己可以测试一下啊。

 

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

 

Dim st As Date = Date.Now '将开始时间保存在变量st中
e.Form.Controls("Label2").Text = ""
Dim c As Date = vars("cc")
Dim n As Integer = 1
Dim f0 As String = "报表\报表" & Format(c,"yyyyMM")
Dim f1 As String = "模板\基层报表模板.xls"
For Each file As String In filesys .GetFiles(ProjectPath & "报表1")
    If file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim Book1 As New XLS.Book(file)
        Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
        Dim s As String  = Sheet2(3,0).Value
        Dim tt As Table = Tables("单位")
        For i1 As Integer = 0 To tt.Rows.Count - 1
            If s.Contains(tt.Rows(i1)("单位1")) Then
                s = tt.Rows(i1)("单位2")
                s = s & Format(c,"yyyyMM")
                Exit For
            End If
        Next
        Dim f2 As String = f0 & "\" & s & Format(c,"yyyyMM") & ".xls"
        If FileSys.FileExists(f2) Then
            If MessageBox.Show(s & "公司报表已另存,是否重新另存?","确认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
                FileSys.DeleteFile(f2)
            End If
        End If
        If not FileSys.FileExists(f2) Then
            e.Form.Controls("Label2").Text = "正在另存" & n & "子公司报表,请稍后..."
            Application.DoEvents()
            Dim App As New MSExcel.Application
            Dim wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & f1)
            Dim ws1 As MSExcel.WorkSheet = wb.WorkSheets("分户快报")
            Dim ws2 As MSExcel.WorkSheet = wb.WorkSheets("资产负债表")
            Dim ws3 As MSExcel.WorkSheet = wb.WorkSheets("利润及分配表")
            Dim ws4 As MSExcel.WorkSheet = wb.WorkSheets("费用表")
            Dim ws5 As MSExcel.WorkSheet = wb.WorkSheets("工资月报")
            Dim ws6 As MSExcel.WorkSheet = wb.WorkSheets("附列资料")
            Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
            Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
            Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
            Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
            Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
            ws2.cells(4,1).Value = Sheet2(3,0).Value   '单位名称
            ws2.cells(2,1).Value = Sheet2(1,0).Value   '日期
            '分户快报
            For n1 As Integer = 3 To 5
                For n2 As Integer = 4 To 48
                    If  ws1.cells(n2+1,n1+1).Formula = "" Then
                        ws1.cells(n2+1,n1+1).Value = val(Sheet1(n2,n1).Value)
                    End If
                Next
            Next
            '资产负债表
            For n1 As Integer = 2 To 3
                For n2 As Integer = 5 To 54
                    If ws2.cells(n2+1,n1+1).Formula = "" Then
                        ws2.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value)
                    End If
                    If ws2.cells(n2+1,n1+5).Formula = "" Then
                        ws2.cells(n2+1,n1+5).Value = val(Sheet2(n2,n1+4).Value)
                    End If
                Next
            Next
            '利润及分配表
            For n1 As Integer = 2 To 3
                For n2 As Integer = 6 To 35
                    If ws3.cells(n2+1,n1+1).Formula = "" Then
                        ws3.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value)
                    End If
                    If ws3.cells(n2+1,n1+5).Formula = "" Then
                        ws3.cells(n2+1,n1+5).Value = val(Sheet3(n2,n1+4).Value)
                    End If
                Next
            Next
            '费用表
            For n1 As Integer = 3 To 6
                For n2 As Integer = 4 To 32
                    If ws4.cells(n2+1,n1+1).Formula = "" Then
                        ws4.cells(n2+1,n1+1).Value = val(Sheet4(n2,n1).Value)
                    End If
                Next
            Next
            '工资月报
            For n1 As Integer = 3 To 4
                For n2 As Integer = 4 To 24
                    If ws5.cells(n2+1,n1+1).Formula = "" Then
                        ws5.cells(n2+1,n1+1).Value = val(Sheet5(n2,n1).Value)
                    End If
                Next
            Next
            '附列资料
            For n1 As Integer = 1 To 13
                For n2 As Integer = 2 To 19
                    If  ws6.cells(n2+1,n1+1).Formula = "" Then
                        ws6.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value)
                    End If
                Next
            Next
            FileSys.DeleteFile(file)
            For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
                ws1.UsedRange.Formula = ws1.UsedRange.Formula
                ws1.Activate
                app.ActiveWindow.DisplayZeros = False
            Next
            n = n + 1
            wb.saveas(ProjectPath & f2)
            wb.close
            App.Quit
        End If
    End If
Next
e.Form.Controls("Label2").Text = "已经完成另存" & n-1 & "子公司!"
MessageBox.Show("耗时: " & (Date.Now - st).TotalSeconds & "秒") '计算并显示执行代码所花费的秒数

生成一个报表需要2.21875秒。

真的太慢了！

32个报表用时：75.015625秒，如何才可以提高另存速度呢？