-- 作者:cnsjroom
-- 发布时间:2022/9/22 3:02:00
-- 选择excel文件 删除指定行与列 并新增列与赋值 然后怎么合并到狐表中呢?
选择excel文件 删除指定行与列 并新增列与赋值 然后怎么合并到狐表中呢?
当前代码如下:
If FileSys.DirectoryExists("C:\\MyFolder") Then \'如果目录C:\\MyFolder存在 FileSys.DeleteDirectory("C:\\MyFolder",2,3) \'则删除之 Else FileSys.CreateDirectory("C:\\MyFolder") End If If FileSys.DirectoryExists("C:\\MyFolder1") Then \'如果目录C:\\MyFolder存在 FileSys.DeleteDirectory("C:\\MyFolder1",2,3) \'则删除之 Else FileSys.CreateDirectory("C:\\MyFolder1") End If Dim dlg As New OpenFileDialog dlg.Filter = "excel文件|*.xls;*.xlsx" dlg.MultiSelect = True \'允许选择多个文件 If dlg.ShowDialog =DialogResult.OK Then For Each fl As String In dlg.FileNames Dim Book As New XLS.Book(fl) \'定义一个Excel工作簿 Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表 Output.Show(Sheet.Rows.Count) Sheet.Rows.RemoveAt(2) \'在最前面插入一行 Sheet.Rows.RemoveAt(0) \'在最前面插入一行 \'Sheet.Cols.RemoveAt(0) \'在最前面插入一列 Sheet.Cols.Insert(0) Sheet.Cols.Insert(0) Dim f2 As String ="C:\\MyFolder\\test.xlsx" Book.Save(f2) Dim bm As String Dim f3 As String ="C:\\MyFolder1\\test.xlsx" Dim App As New MSExcel.Application try Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(f2) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) Dim s1 As String =FileSys.GetName(fl) Dim s2 As String Dim s3 As String s2 = s1.SubString(0,4) s3 = s1.SubString(4,2) Output.Show("s2 = " & s2) Output.Show("s3 = " & s3) Dim Values() As String Values = s1.Split(".") For Index As Integer = 0 To Values.Length - 1 bm=Values(0) Next Ws.Name = bm Dim Rg As MSExcel.Range For i As Integer = 1 To Sheet.Rows.Count Rg = Ws.Cells(i,1) Rg.Value = s2 Rg = Ws.Cells(i,2) Rg.Value = s3 Next Wb.SaveAs(f3) App.Visible = False catch ex As exception finally app.quit End try Dim mg As New Merger mg.SourcePath = f3 mg.Format = "excel" \'指定格式 mg.SourceTableName = bm & "$" mg.DataTableName = "表C" mg.Merge() Next End If \'
红色部分代码合并失败,导入的数据为空,但是有新增行……
[此贴子已经被作者于2022/9/22 3:04:50编辑过]
|
-- 作者:cnsjroom
-- 发布时间:2022/9/22 10:55:00
-- 回复:(有点蓝)1、execl文件的第一行必须是列名,不...
好的 再麻烦老师一下
下面的代码可以基本实现excel表按照指定条件进行删除行与列 并对应写值 创建临时表 合并数据
但是部分excel文件会提示如下错误:【怎么解决呢?】
.NET Framework 版本:4.0.30319.42000 Foxtable 版本:2022.1.30.2 错误所在事件: 详细错误信息:
Microsoft Office Access 数据库引擎找不到对象“202208AJT15_下属各单位检查1-8月$”。请确定该对象存在,并正确拼写其名称和路径名。
Microsoft Office Access 数据库引擎找不到对象“202208AJT20_实践情况统计表1-8月$”。请确定该对象存在,并正确拼写其名称和路径名。
当前代码如下:
Dim dlg As New OpenFileDialog dlg.Filter = "excel文件|*.xls;*.xlsx" dlg.MultiSelect = True \'允许选择多个文件 If dlg.ShowDialog =DialogResult.OK Then For Each fl As String In dlg.FileNames Dim Book As New XLS.Book(fl) \'定义一个Excel工作簿 Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表 Output.Show(Sheet.Rows.Count) Dim bb As Integer=Sheet.Rows.Count Dim s1 As String =FileSys.GetName(fl) Dim s2 As String Dim s3 As String s2 = s1.SubString(0,4) s3 = s1.SubString(4,2) Output.Show("s2 = " & s2) Output.Show("s3 = " & s3) Dim 判断文件名 As String =FileSys.GetName(fl) If 判断文件名.Contains("AJT1") Then Sheet.Rows.RemoveAt(26) \'在最前面插入一行 Sheet.Rows.RemoveAt(25) \'在最前面插入一行 For ii As Integer = 0 To 5 Sheet.Rows.RemoveAt(0) \'在最前面插入一行 Next For ii As Integer = 0 To 3 Sheet.Cols.RemoveAt(0) \'在最前面插入一行 Next Else If 判断文件名.Contains("AJT15") Then For ii As Integer = 0 To 4 Sheet.Rows.RemoveAt(0) \'在最前面插入一行 Next Else If 判断文件名.Contains("AJT20") Then For ii As Integer = 0 To 3 Sheet.Rows.RemoveAt(0) \'在最前面插入一行 Next End If Sheet.Cols.Insert(0) Sheet.Cols.Insert(0) Dim f2 As String ="C:\\MyFolder\\" & FileSys.GetName(fl) & ".xlsx" If FileSys.FileExists(f2) Then FileSys.DeleteFile(f2,2,2) \'则彻底删除之 End If Book.Save(f2) “选择多个文件的时候,这里保存的数量与选择的数量是一致的!” Dim bm As String Dim f3 As String ="C:\\MyFolder1\\" & FileSys.GetName(fl) & ".xlsx" If FileSys.FileExists(f3) Then FileSys.DeleteFile(f3,2,2) \'则彻底删除之 End If Dim App As New MSExcel.Application try Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(f2) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) Dim Values() As String Values = s1.Split(".") For Index As Integer = 0 To Values.Length - 1 bm=Values(0) Next Ws.Name = bm Dim Rg As MSExcel.Range For i As Integer = 1 To Sheet.Rows.Count Rg = Ws.Cells(1,1) Rg.Value = "A" Rg = Ws.Cells(1,2) Rg.Value = "B" Rg = Ws.Cells(1,3) Rg.Value = "C" Rg = Ws.Cells(i+1,1) Rg.Value = s2 Rg = Ws.Cells(i+1,2) Rg.Value = s3 Next Wb.SaveAs(f3) ‘当选择多个文件的时候,这里只会有一个文件保存了,没有对应跟上面的Book.Save(f2)保存的数量一样’ App.Visible = False catch ex As exception finally app.quit End try If DataTables.Contains(FileSys.GetName(fl)) Then \'如果表C已经加载 DataTables.Unload(FileSys.GetName(fl)) \'卸载表C End If Dim dtb As New DataTableBuilder(FileSys.GetName(fl)) dtb.AddDef("A", Gettype(String),50) dtb.AddDef("B", Gettype(String),50) dtb.AddDef("C", Gettype(String),50) For ii As Integer = 1 To 50 dtb.AddDef(ii, Gettype(Integer)) Next dtb.Build() MainTable= Tables(FileSys.GetName(fl) ) Dim mg As New Merger mg.SourcePath = f3 mg.Format = "excel" \'指定格式 mg.SourceTableName = bm & "$" mg.DataTableName = FileSys.GetName(fl) mg.Merge() Next End If \'
|
-- 作者:cnsjroom
-- 发布时间:2022/9/22 11:11:00
-- 回复:(有点蓝)说明execl文件里没有【202208AJT15_下...
老师 红色部分都不弹出值 找不到错误到底出现在哪里了
Dim bm As String Dim App As New MSExcel.Application try msgbox(11) Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(f2) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1) Dim Values() As String Values = s1.Split(".") For Index As Integer = 0 To Values.Length - 1 bm=Values(0) Next Ws.Name = bm msgbox(12) Dim Rg As MSExcel.Range For i As Integer = 1 To Sheet.Rows.Count Rg = Ws.Cells(1,1) Rg.Value = "A" Rg = Ws.Cells(1,2) Rg.Value = "B" Rg = Ws.Cells(1,3) Rg.Value = "C" Rg = Ws.Cells(i+1,1) Rg.Value = s2 Rg = Ws.Cells(i+1,2) Rg.Value = s3 Next msgbox(13) msgbox(f3) Wb.SaveAs(f3) App.Visible = False catch ex As exception msgbox(ex.message) finally app.quit End try
|