程序执行了一会后报错，老师帮忙看看
此主题相关图片如下：513.png
1、下列代码执行的时候能执行一会后报
button按钮调用代码：
Dim FilePath As String = e.Form.Controls("TextBox1").value
Functions.Execute("处理SHEET",FilePath)
——————————————
处理SHEET函数代码：
Dim st As Date = Date.Now
Dim txt4 As WinForm.TextBox = Forms("窗口1").Controls("TextBox4")
Dim cm As WinForm.ComboBox = Forms("窗口1").Controls("ComboBox1")
Dim lbl As WinForm.Label = Forms("窗口1").Controls("Label6")
Dim lbl8 As WinForm.Label = Forms("窗口1").Controls("Label8")
Dim lbl9 As WinForm.Label = Forms("窗口1").Controls("Label9")
Dim lbl11 As WinForm.Label = Forms("窗口1").Controls("Label11")
Dim Numcb1 As WinForm.NumericComboBox = Forms("窗口1").Controls("NumComBox1")
Dim Numcb2 As WinForm.NumericComboBox = Forms("窗口1").Controls("NumComBox2")
Dim path As String = args(0)
Dim file As Object
Dim app As new MSExcel.Application
Dim dic As new Dictionary(of String,String)
Dim dicfile As String = Forms("窗口1").Controls("TextBox2").value
Dim Book As New XLS.Book(dicfile) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) '引用工作簿的第一个工作表
For i As Integer = 0 To Sheet.Rows.Count-1
If dic.ContainsKey(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) = False Then
dic.add(Sheet(i, 0).Text.ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""),Sheet(i, 1).Text)
End If
Next
For Each file In FileSys.GetFiles(path)
Dim excelcol As Integer
Dim excelrows As Integer
If file.EndsWith(".xls") OrElse file.EndsWith(".XLS") OrElse file.EndsWith(".xlsx") OrElse file.EndsWith(".XLSX") Then
If file.EndsWith(".xls") OrElse file.EndsWith(".XLS") Then
excelcol = 256
excelrows =65536
Else
excelcol = 16384
excelrows =1048576
End If
Dim wb=app.WorkBooks.open(file)
For k As Integer=1 To wb.worksheets.Count
If Wb.WorkSheets(k).Visible <> 0 Then '如果sheet表为不隐藏时处理(0隐藏,-1为不隐藏
Dim Ws As MSExcel.WorkSheet=Wb.WorkSheets(k)
If Numcb1.Text = Nothing And Numcb2.Text = Nothing Then
RowsMax = 0
ColsMax = ws.UsedRange.columns.count
'获取最大行
For i As Integer = 1 To ColsMax
Dim r = ws.cells(excelrows,i).End(MsExcel.XlDirection.xlUp).Row
If r > RowsMax Then
RowsMax = r
End If
Next
'获取最大列
For i As Integer = 1 To RowsMax
Dim r = ws.cells(i,excelcol).End(MsExcel.XlDirection.xlToLeft).Column
If r > ColsMax Then
ColsMax = r
End If
Next
Else
RowsMax = Numcb1.Value
ColsMax = Numcb2.Value
End If
Dim rg As MSExcel.Range = Ws.Range(Ws.Cells(1,1), Ws.Cells(RowsMax,ColsMax))
If rg.Count = 1 And rg(1).Value Is Nothing Then
Continue For
End If
Functions.AsyncExecute("异数函数",app,wb,ws,dic,RowsMax,ColsMax,rg) '异步函数
End If '不处理隐藏sheet
Next
Dim txt1 As WinForm.TextBox = Forms("窗口1").Controls("TextBox3")
txt1.text = file & vbcrlf & txt1.text & vbcrlf
Application.DoEvents()
FileCount=FileCount+1
lbl.Text="共处理" & FileCount & "个文件"
wb.Save
app.quit
End If
Next
lbl9.Text="计算结束, 耗时: " & (Date.Now - st).TotalSeconds & "秒"
————————————————
异数函数代码：
Dim app = args(0)
Dim wb = args(1)
Dim ws = args(2)
Dim dic = args(3)
Dim RowsMax = args(4)
Dim ColsMax = args(5)
Dim rg = args(6)
Dim ary = rg.value
For i As Integer=1 To RowsMax
For j As Integer = 1 To ColsMax
If ary(i, j) <> Nothing AndAlso Typeof ary(i,j) Is String AndAlso dic.ContainsKey(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), "")) Then
'lbl11.text= "Sheet名称:" & ws.name
output.show(i & "," & j)
rg(i, j).Value= dic(ary(i,j).ToLower.Replace(" ","").Replace(chr(10), "").Replace(chr(13), ""))
End If
Next
Next
加好友 
发短信
Post By：2021/5/10 16:19:00 [显示全部帖子]
