把当前表的数据加载到另外的表 （5千多条）花了好多分钟 代码如下：

Dim Cols1() As String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","收货时间","是否采购订单","车型","司机","车牌","车数","出车日期" }
Dim Cols2() As String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","收货时间","是否采购订单","车型","司机","车牌","车数","出车日期" }
Dim count As Integer = 0
systemready = False
For Each r As Row In Tables("配载订单").GetCheckedRows
    Dim filter As String = "1=1"
    For Each dc As String In Cols1
        If r.IsNull(dc) Then
            filter &= " and " & dc & " is null"
        Else
            Dim c As Col = Tables("客服跟单").Cols(dc)
            If c.IsNumeric Then
                filter &= " and " & dc & " = " & r(dc)
            ElseIf c.IsBoolean Then
                If r(dc) = True Then
                    filter &= " and " & dc & " = true"
                Else
                    filter &= " and " & dc & " = false"
                End If
            ElseIf c.IsDate Then
                filter &= " and " & dc & " = #" & r(dc) & "#"
            Else
                filter &= " and " & dc & " = \'" & r(dc) & "\'"
            End If
        End If
    Next
    Dim dr As DataRow = DataTables("客服跟单").find(filter)
    If dr Is Nothing Then
        dr = DataTables("客服跟单").AddNew
        count += 1
    End If
    For i As Integer = 0 To Cols1.Length -1
        If r.IsNull(Cols1(i)) Then
            dr(Cols2(i)) = Nothing
        Else
            dr(Cols2(i)) = r(Cols1(i))
        End If
    Next
   
Next
systemready = True
msgbox("共有 "& count &" 条数据提交" )
Tables("配载订单").save
Tables("配载订单").ClearCheckedRows

需要如何改进

Dim Cols1() As String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","收货时间","是否采购订单","车型","司机","车牌","车数","出车日期" }
Dim Cols2() As String = {"项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","收货时间","是否采购订单","车型","司机","车牌","车数","出车日期" }
Dim count As Integer = 0
Dim ls As new List(of Row)
Dim dic As new Dictionary (Of DataRow, Row)
systemready = False
For Each r As Row In Tables("配载订单").GetCheckedRows
    Dim filter As String = "1=1"
    For Each dc As String In Cols1
        If r.IsNull(dc) Then
            filter &= " and " & dc & " is null"
        Else
            Dim c As Col = Tables("客服跟单").Cols(dc)
            If c.IsNumeric Then
                filter &= " and " & dc & " = " & r(dc)
            ElseIf c.IsBoolean Then
                If r(dc) = True Then
                    filter &= " and " & dc & " = true"
                Else
                    filter &= " and " & dc & " = false"
                End If
            ElseIf c.IsDate Then
                filter &= " and " & dc & " = #" & r(dc) & "#"
            Else
                filter &= " and " & dc & " = \'" & r(dc) & "\'"
            End If
        End If
    Next
    Dim dr As DataRow = DataTables("客服跟单").find(filter)
    If dr Is Nothing Then
        ls.Add(r)
        count += 1
    Else
        dic.add(dr, r)
    End If
   
Next
For Each r As Row In ls
    Dim dr As DataRow = DataTables("客服跟单").AddNew
    For i As Integer = 0 To Cols1.Length -1
        If r.IsNull(Cols1(i)) Then
            dr(Cols2(i)) = Nothing
        Else
            dr(Cols2(i)) = r(Cols1(i))
        End If
    Next
Next
For Each key As DataRow In dic.Keys
    Dim r As Row = dic(key)
    Dim dr As DataRow = key
    For i As Integer = 0 To Cols1.Length -1
        If r.IsNull(Cols1(i)) Then
            dr(Cols2(i)) = Nothing
        Else
            dr(Cols2(i)) = r(Cols1(i))
        End If
    Next
Next

systemready = True
msgbox("共有 "& count &" 条数据提交" )
Tables("配载订单").save
Tables("配载订单").ClearCheckedRows

更换代码之后 加载到另一张表用时三分钟 （正常嘛 ）5588条数据 另一张表的DataColChanged事件里有：

For Each r As Row In Tables("客服跟单").Rows
    r("项目") = r("项目").Trim
Next

datacolchanged事件不要这样写代码。

换成

If e.DataCol.Name = "项目" Then

    e.DataRow("项目") = e.DataRow("项目").Trim

End If

如果还觉得慢，就加上代码

http://www.foxtable.com/help/topics/0401.htm

For Each r As Row In ls
    Dim dr As DataRow = DataTables("客服跟单").AddNew
    For i As Integer = 0 To Cols1.Length -1
        If r.IsNull(Cols1(i)) Then
            dr(Cols2(i)) = Nothing
        Else
            dr(Cols2(i)) = r(Cols1(i))
        End If
    Next
Next
For Each key As DataRow In dic.Keys
    Dim r As Row = dic(key)
    Dim dr As DataRow = key
    For i As Integer = 0 To Cols1.Length -1
        If r.IsNull(Cols1(i)) Then
            dr(Cols2(i)) = Nothing
        Else
            dr(Cols2(i)) = r(Cols1(i))
        End If
    Next
Next
 Next
    .ResumeRedraw
End With

这样加绘制吗？

可是加了绘制限制 也还是3分钟啊

你查找的条件多，而且查找的数据量大，耗时是肯定的。

但2楼的代码应该不会运行太久，具体上传例子说明。