两万三千多条数据，从EXCEl表中导入到狐表中用了近60分，想提高些速度 ，代码如何优化一下？谢谢老师！！
e.Form.Controls("Label7").Text = "正在导入EXCEL中的数据,大约3600秒,60分钟左右,请稍后..."
Application.DoEvents()
Dim timestart, timeend As Date
timestart = Date.now
Dim r As Row
Dim i, j As Integer
Dim t1, t2 As Table
Dim str1, str2 As String
Dim str As String
t1 = Tables(Vars("btname11"))
't1.StopRedraw
t2 = e.form.Controls("Table1").Table
str1 = e.form.Controls("TextBox1").value
str2 = e.form.Controls("ComboBox1").value
'Dim prb As WinForm.ProgressBar = e.Form.Controls("ProgressBar1")
If str1 = "" OrElse str2 = "" Then
Return
End If
Dim Book As New XLS.Book(str1)
Dim Sheet As XLS.Sheet = Book.Sheets(str2)
If e.Form.Controls("CheckBox1").checked = False Then
For Each r In t2.Rows
If r.IsNull("来源字段") OrElse r.IsNull("接收字段") Then
MessageBox.Show("字段匹配未完成!")
Return
End If
Next
Dim dr As DataRow
For i = 1 To Sheet.Rows.Count - 1
Dim sss As String = ""
' prb.Visible = True
' prb.Maximum = Sheet.Rows.Count - 1
For j = 0 To t2.Rows.count - 1
If sss > "" Then sss = sss & " and "
sss = sss & t2.Rows(j)("接收字段") & "='" & Sheet(i, t2.Rows(j)("来源列数")).Value & "'"
Next
dr = DataTables(Vars("btname11")).find(sss)
If dr Is Nothing Then
Dim r1 As Row = Tables(Vars("btname11")).addnew
For j = 0 To t2.Rows.count - 1
Dim ss As String = Sheet(i, t2.Rows(j)("来源列数")).Value
r1(t2.Rows(j)("接收字段")) = ss.Replace(" ", "").Trim()
Next
End If
' prb.Value = i
Next
t1.DataTable.save
MessageBox.Show("数据导入完毕!")
Else
For j = 0 To Sheet.Cols.count - 1
If t1.cols.Contains(Sheet(0, j).value) Then
If str = "" Then
str = Sheet(0, j).value
str = str.Replace(" ", "").Trim()
Else
str = str & "," & Sheet(0, j).value
str = str.Replace(" ", "").Trim()
End If
End If
Next
If str = "" Then
MessageBox.Show("对不起,没有匹配字段!")
Return
End If
If MessageBox.Show("是否只导入匹配字段?", "询问", MessageBoxButtons.YesNo, MessageBoxIcon.Question) = DialogResult.Yes Then
Dim dr As DataRow
For i = 1 To Sheet.Rows.Count - 1
Dim sss As String = ""
' prb.Visible = True
' prb.Maximum = Sheet.Rows.Count - 1
For Each r In Tables(Vars("btname11")).Rows
For j = 0 To str.split(",").Length - 1
If sss > "" Then sss = sss & " and "
'MessageBox.Show(str.split(",")(j))
'MessageBox.Show(r Is Nothing)
'MessageBox.Show(r(str.split(",")(j)))
'sss = sss & r(str.split(",")(j)) & "='" & sss.Replace(" ", "").Trim & "'"
sss = sss & str.split(",")(j) & "='" & Sheet(i, t2.Rows(j)("来源列数")).Value & "'"
'MessageBox.Show(sss)
Next
Next
dr = DataTables(Vars("btname11")).find(sss)
If dr Is Nothing Then
r = t1.AddNew()
For j = 0 To str.split(",").Length - 1
r(str.split(",")(j)) = Sheet(i, t2.Rows(j)("来源列数")).Value
Next
t1.DataTable.save
End If
Next
Else
Return
End If
' prb.Value = i
MessageBox.Show("数据导入完毕!")
End If
't1.ResumeRedraw
'e.Form.close
e.Form.Controls("Label7").Text = "EXCEL中的数据导入完毕!"
timeend = Date.now
e.Form.Controls("Label7").text = "EXCEL中的数据导入完毕!!耗时" & (timeend - timestart).TotalSeconds & "秒"
Messagebox.Show("从EXCEL中的数据导入完毕!,请继续!")
加好友 
发短信
Post By：2023/12/9 9:35:00 [显示全部帖子]
