Foxtable(狐表) → 用户栏目 → 专家坐堂 → EXCEL自动更新表


  共有12065人关注过本帖树形打印复制链接

主题：EXCEL自动更新表
帅哥哟，离线，有人找我吗？
发财
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		EXCEL自动更新表  发帖心情 Post By：2014/8/26 15:56:00 [显示全部帖子]

Dim Book As New XLS.Book(ProjectPath & "汇总单表\汇总单表.xls")
Dim Sheet1 As XLS.Sheet = Book.Sheets("日期")
Dim cj As WinForm.DateTimePicker = e.Form.Controls("DateTimePicker2")
If cj.Text =Nothing Then
    messagebox.show("请在导入月终日期输入日期!")
Else
    Sheet1(3,3).Value = cj.text
    Sheet1(6,3).Value = cj.text
    Book.Save(ProjectPath & "汇总单表\汇总单表1.xls")
    Dim App As New MSExcel.Application
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(ProjectPath & "汇总单表\汇总单表1.xls")
    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 Ws7 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
    Dim Ws8 As MSExcel.WorkSheet = Wb.WorkSheets("茂名快报")
    Dim Ws9 As MSExcel.WorkSheet = Wb.WorkSheets("分单位")
    Dim Ws10 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债指标表")
    Dim Ws11 As MSExcel.WorkSheet = Wb.WorkSheets("利润及相关指标表")
    ws1.UsedRange.Formula = ws1.UsedRange.Formula
    ws2.UsedRange.Formula = ws2.UsedRange.Formula
    ws3.UsedRange.Formula = ws3.UsedRange.Formula
    ws4.UsedRange.Formula = ws4.UsedRange.Formula
    ws5.UsedRange.Formula = ws5.UsedRange.Formula
    ws6.UsedRange.Formula = ws6.UsedRange.Formula
    ws7.UsedRange.Formula = ws7.UsedRange.Formula
    ws8.UsedRange.Formula = ws8.UsedRange.Formula
    ws9.UsedRange.Formula = ws9.UsedRange.Formula
    ws10.UsedRange.Formula = ws10.UsedRange.Formula
    ws11.UsedRange.Formula = ws11.UsedRange.Formula

    wb.save
    wb.close
    App.Quit
    
    Dim Proc As New Process
    Proc.File = (ProjectPath & "汇总单表\汇总单表1.xls")
    Proc.Start()
End If
其中汇总单表链接表外数据，每次打开时都要求自动更新的，因而打开时出现错误报表，并自动添加了一个表ONGRGUT,不知如何修改呢？
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/26 16:28:00 [显示全部帖子]

全部用vba做就行了。感谢了！

 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 15:36:00 [显示全部帖子]

Dim aa1() As String = {"日期","分户快报","资产负债表","利润及分配表","费用表","附列资料","工资月报","茂名快报","分单位","资产负债指标表","利润及相关指标表"}
For i1 As Integer = 1 To 11
            Dim Ws(i1) As MSExcel.WorkSheet = Wb.WorkSheets(aa1(i1))
Next
上述代码为什么不行？
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 15:43:00 [显示全部帖子]

还是不行？

 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 16:33:00 [显示全部帖子]

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 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 Ws7 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
            Dim Ws8 As MSExcel.WorkSheet = Wb.WorkSheets("茂名快报")
            Dim Ws9 As MSExcel.WorkSheet = Wb.WorkSheets("分单位")
            Dim Ws10 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债指标表")
            Dim Ws11 As MSExcel.WorkSheet = Wb.WorkSheets("利润及相关指标表")
            Ws1.cells(4,4) = cj.text
            Ws1.cells(7,4) = cj.text
            rg1 =  Ws3.cells(14,5)
            rg2 =  Ws3.cells(15,9)
            rg3 = Ws4.cells(23,5)
            rg4 = Ws4.cells(31,5)
            rg5 =  Ws5.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")
            ws1.UsedRange.Formula = ws1.UsedRange.Formula
            ws2.UsedRange.Formula = ws2.UsedRange.Formula
            ws3.UsedRange.Formula = ws3.UsedRange.Formula
            ws4.UsedRange.Formula = ws4.UsedRange.Formula
            ws5.UsedRange.Formula = ws5.UsedRange.Formula
            ws6.UsedRange.Formula = ws6.UsedRange.Formula
            ws7.UsedRange.Formula = ws7.UsedRange.Formula
            ws8.UsedRange.Formula = ws8.UsedRange.Formula
            ws9.UsedRange.Formula = ws9.UsedRange.Formula
            ws10.UsedRange.Formula = ws10.UsedRange.Formula
            ws11.UsedRange.Formula = ws11.UsedRange.Formula
            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
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 16:35:00 [显示全部帖子]

1.我想简化ws1至ws11
2.粘贴回数值时出现错误：Overload resolution failed because no accessible 'Chars' accepts this number of arguments.
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 16:48:00 [显示全部帖子]

上述粘贴回数值时出现错误：Overload resolution failed because no accessible 'Chars' accepts this number of arguments.
是什么原因？
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 17:03:00 [显示全部帖子]

       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
不知粘贴回数值时出现什么问题？
 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 17:14:00 [显示全部帖子]

你之前教我批量粘贴回数值。但用在这个表却不行？

 回到顶部
帅哥哟，离线，有人找我吗？
发财
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：六尾狐 帖子：1470 积分：8981 威望：0 精华：0 注册：2013/10/24 9:12:00 		  发帖心情 Post By：2014/8/27 17:18:00 [显示全部帖子]

 这句代码的问题： If ary(i,j) > "" AndAlso ary(i,j).Toupper.StartsWith("=" & d) Then

 回到顶部
总数 62 1 2 3 4 5 6 7 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05859 秒, 5 次数据查询