主题：[求助]execl工作簿内容合并

老师好！

execl文件内容合并时，遇到两个问题：

1、第一个工作表需要加标题行，因此代码是不连续行的复制；结果成了连续的值。

2、后面的表取textbox起始和结束的值，进行连续行复制。结果复制的行数不对。

请老师看看是哪里的问题？

谢谢！

  

代码如下：

'''
Dim i As Integer = 0 '定义文件数
Dim dlg As New OpenFileDialog
dlg.Filter= "Excel文件|*.xls;*.xlsx" '设置筛选器
dlg.MultiSelect = True
If dlg.ShowDialog = DialogResult.OK Then
    Dim i1 As Integer = e.Form.Controls("TextBox12").Value
    Dim i2 As Integer = e.Form.Controls("TextBox13").Value
    Dim i3 As Integer = e.Form.Controls("TextBox03").Value
    Dim stt As Date = Date.Now   '开始计时
   
    Dim App As New MSExcel.Application
    try
        Dim Wb As MSExcel.Workbook = App.WorkBooks.Add
        'Dim Wb As MSExcel.Workbook = App.WorkBooks.open("f:\test.xls")
        Dim ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
        Dim rg As MSExcel.Range  = ws.Cells(ws.UsedRange.Rows.Count+1,1)
        app.DisplayAlerts = False
       
        Dim Wb2 As MSExcel.Workbook
        For Each file As String In dlg.FileNames
            Wb2 = App.WorkBooks.open(file)
            Dim Ws2 As MSExcel.WorkSheet = Wb2.WorkSheets(1)
           
            If e.Form.Controls("CheckBox10").checked Then
                Dim Rg2 As MSExcel.Range = Ws2.UsedRange '引用使用过的单元格
                Rg2.Copy
               
            ElseIf e.Form.Controls("CheckBox07").checked
                If i1 = Nothing Or i2 = Nothing Or i3 = Nothing Then
                    msgbox("请录入工作表标题行或起始行或结束行!")
                Else
                    If i = 0 Then
                        Dim Rg2 As MSExcel.Range = Ws2.Range(i3 & ":" & i3,i1 & ":" & i2) '引用不连续的多行，添加标题行
                        Rg2.Copy
                    Else
                        Dim Rg2 As MSExcel.Range = Ws2.Range(i1 & ":" & i2)  '引用连续的多行
                        Rg2.Copy
                    End If
                End If
            End If
           
            rg.PasteSpecial()
            rg = ws.Cells(ws.UsedRange.Rows.Count+1,1)
            Wb2.Close
            i= i+1
        Next
        'Wb.Save
        Wb.SaveAs(ProjectPath & "Attachments\execl合并\" & "合并" & Format(Date.now,"MMddHmmss") & ".xls")
        Wb.Close
        App.Quit
    catch ex As Exception
        App.Quit
    End try
    msgbox（"execl合并" & i & "个" & vbcrlf & "耗时:" & (Date.Now - stt).TotalSeconds & "秒"）
    Dim Proc As New Process              '打开目录
    Proc.File = ProjectPath & "Attachments\execl合并\"
    proc.start
End If

 

此主题相关图片如下：截屏图片 (3).jpg

 

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:2019-11-12execl合并.rar

谢谢蓝老师！

还存在两个小问题：

1、代码中的结束行i2要加个 “1”才行，但是最后一个文件复制过来的行数就会多一行，当最后一个文件时 i2-1 也调整不过来；

2、生成的execl文件，打开之前提示如下图，点“是”，可以打开。

是什么原因？

 
此主题相关图片如下：截屏图片.jpg

 

If i1 = Nothing Or i2 = Nothing Or i3 = Nothing Then
    msgbox("请录入工作表标题行或起始行或结束行!")
Else
    If i = 0 Then
        Dim Rg2 As MSExcel.Range = Ws2.Range(i3 & ":" & i3 & "," & i1 & ":" & i2 +1) '引用不连续的多行,添加标题行
        Rg2.Copy
    ElseIf i = dlg.FileNames.Length Then  '最后一个文件
        Dim Rg2 As MSExcel.Range = Ws2.Range(i1 & ":" & i2 -1)'引用连续的多行
        Rg2.Copy
    Else
        Dim Rg2 As MSExcel.Range = Ws2.Range(i1 & ":" & i2 +1)'引用连续的多行
        Rg2.Copy
    End If
End If