主题：EXCEL自动更新表

例子，代码，全部发上来。

问问题不要说一句没一句的，别人不知道你什么意思

Dim cj As WinForm.DateTimePicker = e.Form.Controls("DateTimePicker2")
If cj.Text = Nothing Then
    messagebox.show("请在导入月终日期输入日期!")
Else
    Dim y,m,d1 As Integer
    Dim dt2 As Date
    dt2 = vars("cc")
    Dim dt1 As Date = #1/01/0001#
    DateYMD(dt1,dt2, y, m, d1)
    y=y+1
    m=m+1
    d1=d1+1
    Dim f0l As String = "E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls"
    If Not FileSys.FileExists(f0l) Then
        Dim fl As String = "E:\快盘\excel" & y & "\集团汇总" & y & "0" & m & ".xls"
        If Not FileSys.FileExists(fl) Then
            Messagebox.Show("请先生成:集团汇总" & y & "0" & m & "","提示")
        Else
            FileSys.CopyFile("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m-1 & ".xls", ProjectPath & "\汇总单表\上月汇总单表.xls",True)
            FileSys.CopyFile("E:\快盘\excel" & y-1 & "\汇总单表" & y-1 & "0" & m & ".xls", ProjectPath & "\汇总单表\上年同期汇总单表.xls",True)
            FileSys.CopyFile("E:\快盘\excel" & y & "\集团汇总" & y & "0" & m & ".xls", ProjectPath & "\汇总单表\集团汇总.xls",True)
            Dim Book As New XLS.Book(ProjectPath & "汇总单表\汇总单表.xls")
            Dim App As New MSExcel.Application
            Dim rg1,rg2,rg3,rg4,rg5 As MSExcel.Range
           
            Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & "汇总单表\汇总单表.xls")
           
            Dim aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}
            Dim Ws(aa1.Length) As MSExcel.WorkSheet
            For i1 As Integer = 1 To 11
                Ws(i1) = Wb.WorkSheets(aa1(i1))
            Next
            ws(1).cells(4,4) = cj.text
            ws(1).cells(7,4) = cj.text
            rg1 =  ws(3).cells(14,5)
            rg2 =  ws(3).cells(15,9)
            rg3 = ws(4).cells(23,5)
            rg4 = ws(4).cells(31,5)
            rg5 =  ws(5).cells(32,5)
            rg1.value = rg1.value - vars("tx1")
            rg2.value= rg2.value - vars("tx1")
            rg3.value = rg3.value- vars("tx2")
            rg4.value= rg4.value- vars("tx2")
            rg5.value= rg5.value- vars("tx2")
           
            For i1 As Integer = 1 To 11
                ws(i1).UsedRange.Formula = ws(i1).UsedRange.Formula
            Next
            app.displayalerts=False
            wb.saveas("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
            wb.close
            App.Quit
            Dim Proc As New Process
            Proc.File = ("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
            Proc.Start()
        End If
    Else
        If MessageBox.Show("是否将链接粘贴回数值,估计每个表要20秒?","确  认",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) =DialogResult.OK Then
            Dim App As New MSExcel.Application
            Dim Wb As MSExcel.Workbook = App.WorkBooks.open("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
            For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
                Ws.UnProtect
                Dim ds() As String = {"'C", "'D", "'E"}
                Dim Rg As MSExcel.Range = Ws.UsedRange
                Dim ary = rg.Formula
                For i As Integer = 1 To Ws.UsedRange.Rows.Count
                    For j As Integer = 1 To Ws.UsedRange.Columns.Count
                        For Each d As String In ds
                            If ary(i,j) > "" AndAlso ary(i,j).Toupper.StartsWith("=" & d) Then
                                ws.cells(i,j).copy
                                ws.cells(i,j).PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues,   Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)
                            End If
                        Next
                    Next
                Next
            Next
            Wb.Save
            App.Quit
        End If
        Dim Proc As New Process
        Proc.File = ("E:\快盘\excel" & y & "\汇总单表" & y & "0" & m & ".xls")
        Proc.Start()
    End If
End If

改一下

            Dim aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}
            Dim Ws(aa1.Length) As MSExcel.WorkSheet
            For i1 As Integer = 1 To 11
                Ws(i1) = Wb.WorkSheets(aa1(i1-1))
            Next
            ws(1).cells(4,4) = cj.text
            ws(1).cells(7,4) = cj.text
            rg1 =  ws(3).cells(14,5)
            rg2 =  ws(3).cells(15,9)
            rg3 = ws(4).cells(23,5)
            rg4 = ws(4).cells(31,5)
            rg5 =  ws(5).cells(32,5)
            rg1.value = rg1.value - vars("tx1")
            rg2.value= rg2.value - vars("tx1")
            rg3.value = rg3.value- vars("tx2")
            rg4.value= rg4.value- vars("tx2")
            rg5.value= rg5.value- vars("tx2")
           
            For i1 As Integer = 1 To 11
                ws(i1).UsedRange.Formula = ws(i1).UsedRange.Formula
            Next

 提示什么错？有可能是公式不匹配，这个代码的意思是，匹配 =C =D =E 的公式

If ary(i,j) > "" AndAlso ary(i,j).Toupper.StartsWith("=" & d) Then

 你试试改成这样，看有没有问题

'Dim ary = rg.Formula
For i As Integer = 1 To Ws.UsedRange.Rows.Count
    For j As Integer = 1 To Ws.UsedRange.Columns.Count
        For Each d As String In ds
            'If ary(i,j) > "" AndAlso ary(i,j).Toupper.StartsWith("=" & d) Then

            If ws.cells(i,j).Formula > "" AndAlso ws.cells(i,j).Formula.Toupper.StartsWith("=" & d) Then
               

没办法，对cells的访问，和对数值粘贴的操作，本来就是很慢的，何况你有这么多的表。

那你试试这样改

'Dim ary = rg.Formula
For i As Integer = 1 To Ws.UsedRange.Rows.Count
    For j As Integer = 1 To Ws.UsedRange.Columns.Count
        Dim temp As Object = ws.cells(i,j)
        For Each d As String In ds
            If temp.Text > "" AndAlso temp.Text.Toupper.StartsWith("=" & d) Then
                temp.copy
                temp.PasteSpecial(Paste:=MSExcel.XlPasteType.xlPasteValues,   Operation:=MSExcel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, SkipBlanks:=False, Transpose:=False)