[求助]我这段代码是查找excel中标签的但是执行不进去呀 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

这个代码可以用但是有个问题，添加到一个文件里面以后第一个和最后一个格式都是对的，中间的格式都不对，就是上面我发的测试文件，多添加几次四次吧，中间的2次都没有格式

Dim pdfFile = ProjectPath & Vars("pdfTemp") 'excel合并总文件

Dim mb1 As String = args(0)

Dim tf1 As String = args(1)

Dim Book As New XLS.Book(mb1) '打开模版

Book.Build()

Book.Save(tf1) ''根据选择的记录保存到文件中

'''导入文件开始行

'Dim mb As String = mb1

'Dim tf As String = pdfFile

Dim fl As String = tf1

Dim fl2 As String = pdfFile

Dim App As New MSExcel.Application

Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)

Dim Wb2 As MSExcel.WorkBook = App.WorkBooks.Open(fl2)

Dim Ws1 As MSExcel.WorkSheet = Wb2.WorkSheets(1)

Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets(1)

Dim x As Integer = Ws1.UsedRange.Rows.Count

Ws2.UsedRange.Copy

ws1.Select

ws1.Cells(x,1).Select '纵向拷贝

ws1.paste

'设置列格式

ws2.activate

ws2.rows("1:" & ws2.UsedRange.rows.count).Select

app.CutCopyMode = False

app.Selection.Copy

ws1.Activate

ws1.rows(x & ":" & x+ws2.usedRange.rows.count).Select

app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)

'设置行格式

ws2.activate

ws2.columns(ws2.cells(1,1).address.split("$")(1) & ":" & ws2.cells(1,ws2.UsedRange.columns.count).address.split("$")(1)).Select

app.CutCopyMode = False

app.Selection.Copy

ws1.activate

ws1.columns(ws1.cells(1,1).address.split("$")(1) & ":" & ws1.cells(1,ws2.usedRange.columns.count).address.split("$")(1)).Select

app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)

app.CutCopyMode = False

'设置单元格格式

ws2.activate

ws2.UsedRange.Select

app.CutCopyMode = False

app.Selection.Copy

ws1.activate

ws1.range(ws1.cells(x, 1).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, ws2.UsedRange.columns.count).address).Select

app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)

app.CutCopyMode = False

'app.Visible = True

MessageBox.Show(ws2.UsedRange.Rows.count + 1)

Ws2.Rows( ws2.UsedRange.Rows.count + 1).PageBreak = 1

Wb.save

Wb2.Save

App.Quit

[此贴子已经被作者于2019/3/5 21:19:52编辑过]

请上传可以测试的实例说明

就在我前面一个呀测试文件呀，合并的时候，你合并四次，中间的两个文件就没有格式

在前面那个回复上有

34楼的例子我这边没有测试不了，文件不对。请重新上传可以完整测试的实例和execl文件

下载信息 [文件大小：下载次数： ]
点击浏览该文件:上传测试.rar

生成的按钮按三次以上，就会发现一头一尾格式没问题中间格式有问题

Dim mb As String = e.Form.Controls("t1").value

Dim tf As String = e.Form.Controls("tAll").value
'Dim pns As String = args(2)

Dim fl As String = mb
Dim fl2 As String = tf
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)
Dim Wb2 As MSExcel.WorkBook = App.WorkBooks.Open(fl2)
Dim Ws1 As MSExcel.WorkSheet = Wb2.WorkSheets(1)
Dim Ws2 As MSExcel.WorkSheet = Wb.WorkSheets(1)

Dim x As Integer = iif(Ws1.UsedRange.Rows.Count=1, 1, Ws1.UsedRange.Rows.Count+1)
Ws2.UsedRange.Copy
ws1.Select
ws1.Cells(x,1).Select '纵向拷贝
ws1.paste

'设置行格式
ws2.activate
ws2.rows("1:" & ws2.UsedRange.rows.count).Select
app.CutCopyMode = False
app.Selection.Copy
ws1.Activate
ws1.rows(x & ":" & x+ws2.usedRange.rows.count).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)

'设置列格式
If Ws1.UsedRange.Rows.Count <= 40 Then
    ws2.activate
    ws2.columns(ws2.cells(1,1).address.split("$")(1) & ":" & ws2.cells(1,ws2.UsedRange.columns.count).address.split("$")(1)).Select
    app.CutCopyMode = False
    app.Selection.Copy
    ws1.activate
    ws1.columns(ws1.cells(1,1).address.split("$")(1) & ":" & ws1.cells(1,ws2.usedRange.columns.count).address.split("$")(1)).Select
    app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
    app.CutCopyMode = False
End If

'设置单元格格式
ws2.activate
ws2.UsedRange.Select
app.CutCopyMode = False
app.Selection.Copy
ws1.activate
ws1.range(ws1.cells(x, 1).address & ":" & ws1.cells(x+ws2.UsedRange.rows.count, ws2.UsedRange.columns.count).address).Select
app.selection.PasteSpecial(Paste:=-4122, Operation:=-4142,SkipBlanks:=False, Transpose:=False)
app.CutCopyMode = False
'app.Visible = True
Ws2.Rows( ws2.UsedRange.Rows.count + 1).PageBreak = 1
Wb.save
Wb2.Save
App.Quit

万分感谢，ok了

又出现个问题我每次添加要删除之前的内容我是想着选excel左上角这样就全选了然后删除这样所有的内容就没了，要怎么写呀

以下是引用a937775799在2019/3/6 14:28:00的发言：
又出现个问题我每次添加要删除之前的内容我是想着选excel左上角这样就全选了然后删除这样所有的内容就没了，要怎么写呀

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\test.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg = Ws.Cells
Rg.Delete
App.Visible = True

主题：[求助]我这段代码是查找excel中标签的但是执行不进去呀