专家坐堂-代码Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  代码  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=66795)

--  作者：发财
--  发布时间：2015/4/14 8:47:00
--  代码

Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("分户快报")
Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债表")
Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("利润及分配表")
Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
Dim Ws4 As MSExcel.WorkSheet = Wb.WorkSheets("费用表")
Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
Dim Ws5 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
Dim Ws6 As MSExcel.WorkSheet = Wb.WorkSheets("附列资料")
Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
如何使上述代码变得简单直观点？

--  作者：Bin
--  发布时间：2015/4/14 8:50:00
--
你声明两次为了干嘛?

--  作者：发财
--  发布时间：2015/4/14 8:51:00
--

Dim c As Date = vars("cc")
Dim i As Integer
Dim f1 As String = "E:\\快盘\\excel" & c.year & "\\集团汇总" & c.year & Format(c.month,"00") & ".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 App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.open(f1)
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("分户快报")
Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报")
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets("资产负债表")
Dim Sheet2 As XLS.Sheet = Book1.Sheets("资产负债表")
Dim Ws3 As MSExcel.WorkSheet = Wb.WorkSheets("利润及分配表")
Dim Sheet3 As XLS.Sheet = Book1.Sheets("利润及分配表")
Dim Ws4 As MSExcel.WorkSheet = Wb.WorkSheets("费用表")
Dim Sheet4 As XLS.Sheet = Book1.Sheets("费用表")
Dim Ws5 As MSExcel.WorkSheet = Wb.WorkSheets("工资月报")
Dim Sheet5 As XLS.Sheet = Book1.Sheets("工资月报")
Dim Ws6 As MSExcel.WorkSheet = Wb.WorkSheets("附列资料")
Dim Sheet6 As XLS.Sheet = Book1.Sheets("附列资料")
Dim s1 As String = Sheet1(2,1).Value
If Isdate(Sheet1(1,1).value) = False OrElse Sheet1(1,1).value <> vars("cc") Then
MessageBox.Show(s1 & "导入报表日期不正确!")
wb.close
App.Quit
Return
Else
Dim tt As Table = Tables("单位")
For i1 As Integer = 0 To tt.Rows.Count - 1
If s1.Contains(tt.Rows(i1)("单位1")) Then
i = i1
ws1.cells(i+6,2).Value = tt.Rows(i)("单位2")
Exit For
Else
messagebox.show(s1 & "单位名称不存在!")
wb.close
App.Quit
Return
End If
Next
For n As Integer = 27 To 48 \'分户快报
If ws1.cells(i+6,n-1).Formula = "" Then
ws1.cells(i+6,n-1).Value = val(Sheet1(n,3).Value)
End If
Next
For n1 As Integer = 2 To 3
For n2 As Integer = 5 To 54
If ws2.cells(n2+1,n1+1).Value = "" Then
ws2.cells(n2+1,n1+1).Value = val(Sheet2(n2,n1).Value)
End If
If ws2.cells(n2+1,n1+5).Value = "" 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).Value = "" Then
ws3.cells(n2+1,n1+1).Value = val(Sheet3(n2,n1).Value)
End If
If ws3.cells(n2+1,n1+5).Value = "" 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).Value = "" 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).Value = "" 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).Value = "" Then
ws6.cells(n2+1,n1+1).Value = val(Sheet6(n2,n1).Value)
End If
Next
Next
For Each Ws As MSExcel.WorkSheet In Wb.WorkSheets
ws.UsedRange.Formula = ws.UsedRange.Formula
ws.Activate
Next
app.ActiveWindow.DisplayZeros = False
wb.save
wb.close
App.Quit
End If
End If
Next

--  作者：发财
--  发布时间：2015/4/14 8:52:00
--
始终感觉上述代码都很烦？

--  作者：Bin
--  发布时间：2015/4/14 8:55:00
--
关于遍历,之前已经给你写过.

关于声明哪里,看你这代码,完全没必要声明两次, 你直接用
Dim Ws1 As MSExcel.WorkSheet = Wb.WorkSheets("分户快报")
Dim Sheet1 As XLS.Sheet = Book1.Sheets("分户快报") 这句去掉吧

--  作者：发财
--  发布时间：2015/4/14 8:56:00
--
如果用遍历，不能一次完成。

--  作者：Bin
--  发布时间：2015/4/14 9:02:00
--
你多个SheetS 肯定要遍历多次,基本没什么优化空间

--  作者：发财
--  发布时间：2015/5/5 23:01:00
--

ws.UsedRange.Formula = ws.UsedRange.Formula

改为：

sheet.UsedRange.Formula = sheet.UsedRange.Formula

是否效果一样？

--  作者：大红袍03
--  发布时间：2015/5/5 23:09:00
--
不一样

--  作者：发财
--  发布时间：2015/5/6 14:34:00
--
如何做到一样？