以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  从excel中交换数据  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=187935)
--  作者：creastzh
--  发布时间：2023/8/22 8:22:00
--  从excel中交换数据
我每日需要大量交换Excel的数据，因此我使用了合并方式、数组方式，临时表导入方式Excel 数据，最后发现数据的方式可能要快一些，但每次需要交换约2w行数据，交换的过程感觉很慢，一些行数据没有变化就不交换，一旦行内任一数据发生了改变就需要按新的数据写入， 目前数据运算是否变更及写入差不多需要5~6分钟，关键是有时候运行到一定时候还会出现“超出系统资源”错误提示，不知是否有更好的办法， 谢谢！

代码如下：
\'导入 生产计划 Import_WeeklyMachineSchedule

If User.Type = UserTypeEnum.Developer Then
    Dim TableN As String = "WeeklyMachineSchedule"
    If Not DataTables.Contains(TableN) Then
        DataTables(TableN).LoadFilter = ""
        DataTables(TableN).Load
    End If 
    
    Dim fp As String = "P:\\General documents\\Worktime Data\\Fox Data\\Query\\"
    Dim ff = "Weekly Machine Schdule.xlsx"
    Dim fpf As String = fp & ff
    If filesys.FileExists(fpf) Then
        DataTables(TableN).StopRedraw \'停止屏幕刷新
        
        Dim cn As String \'列名称
        Dim i As Integer
        Dim App As New MSExcel.Application
        App.DisplayAlerts = False
        App.visible = True
        Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fpf)
        Dim s1 As Date = Date.Now
        Wb.RefreshAll
        Dim s2 As Date = Date.Now
        Dim s3 As TimeSpan = s2 - s1
        Output.Show(s1 & " -- " & s2 & "  经过时间s:" & s3.TotalSeconds)
        \'MessageBox.Show(s3.TotalSeconds)
        Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
        Dim Rg As MSExcel.Range = Ws.UsedRange
        Dim ary = Rg.value
        Dim cs As Integer = Rg.Columns.Count
        \'cs =5
        
        s2 = Date.Now
        s3 = s2 - s1
        \'MessageBox.Show(s3.TotalSeconds)
        SystemReady = False \'停止所有其它程序 
        Dim bh As Boolean
        Try 
            Dim i1 As Integer = 0
            Dim Filter As String 
            For i = 2 To Rg.Rows.Count 
                If ary(i, 2) > "" AndAlso ary(i, 19) IsNot Nothing Then \'WO OP均存在的情形下
                    Filter = "[WO] = \'" & ary(i, 5) & "\' and [OP] = " & ary(i, 22) \'PN号
                    Dim dr As DataRow = DataTables(TableN).Find(Filter)
                    If dr Is Nothing Then \'新增数据行    
                        Dim ro As Row = Tables(TableN).AddNew
                        
                        For c As Integer = 1 To cs
                            cn = ary(1, c) \'列名
                            If cn = "Process_Competed" Then
                                If Len(ary(i, c)) > 0 Then
                                    ro(cn) = True 
                                Else
                                    ro(cn) = False
                                End If
                            ElseIf cn = "OnProcess" Then
                                If Len(ary(i, c)) > 0 Then
                                    ro(cn) = True 
                                Else
                                    ro(cn) = False
                                End If
                            ElseIf cn = "NPI" Then
                                If Len(ary(i, c)) <= 3 Then
                                    ro(cn) = True 
                                Else
                                    ro(cn) = False
                                End If
                            ElseIf cn = "Setup_Need" Then
                                If ary(i, c) = "Y" Then
                                    ro(cn) = True 
                                Else
                                    ro(cn) = False
                                End If
                            ElseIf cn = "Setup_Status" Then
                                If ary(i, c) = "OK" Then
                                    ro(cn) = True 
                                Else
                                    ro(cn) = False
                                End If
                            Else
                                ro(cn) = ary(i, c)
                            End If
                        Next
                        
                        i1 = i1 + 1
                        ‘Output.Show("新增：" & i1)
                    Else \'已经存在的数据行,须判断是否有修改,简化操作改为直接重写                        
                        For c As Integer = 1 To cs
                            cn = ary(1, c) \'列名
                            bh = False \'初始值
                            If cn = "Process_Competed" Then
                                If Len(ary(i, c)) > 0 Then
                                    bh = True \'变化
                                End If
                                If dr(cn) <> bh Then
                                    dr(cn) = bh
                                    \'Output.Show(dr("WO") & "|" & dr("OP") & "  " & cn & ":" & i)
                                End If
                            ElseIf cn = "OnProcess" Then
                                If Len(ary(i, c)) > 0 Then
                                    bh = True \'变化
                                End If
                                If dr(cn) <> bh Then
                                    dr(cn) = bh
                                    \'Output.Show(dr("WO") & "|" & dr("OP") & "  " & cn & ":" & i)
                                End If
                            ElseIf cn = "NPI" Then
                                If Len(ary(i, c)) <= 3 Then
                                    bh = True \'变化 
                                End If
                                If dr(cn) <> bh Then
                                    dr(cn) = bh
                                    \'Output.Show(dr("WO") & "|" & dr("OP") & "  " & cn & ":" & i)
                                End If
                            ElseIf cn = "Setup_Need" Then
                                If ary(i, c) = "Y" Then
                                    bh = True \'变化
                                End If
                                If dr(cn) <> bh Then
                                    dr(cn) = bh
                                    \'Output.Show(dr("WO") & "|" & dr("OP") & "  " & cn & ":" & i)
                                End If
                            ElseIf cn = "Setup_Status" Then
                                If ary(i, c) = "OK" Then
                                    bh = True \'变化
                                End If
                                If dr(cn) <> bh Then
                                    dr(cn) = bh
                                    \'Output.Show(dr("WO") & "|" & dr("OP") & "  " & cn & ":" & i)
                                End If
                            ElseIf cn = "Cycle_Time_Mins" Or cn = "Reqd_Time_Hrs" Then
                                If dr(cn) - ary(i, c) > 0.03 Then \'循环时间差0.18秒（数据精度引起）
                                    dr(cn) = ary(i, c)
                                End If 
                            Else
                                If dr(cn) <> ary(i, c) Then 
                                    \'Output.Show( i & ":  " & dr("WO") & "|" & dr("OP") & "  " & cn & "变换内容:" & dr(cn) & "--->" & ary(i, c))
                                    dr(cn) = ary(i, c)
                                    i1 = i1 + 1
                                End If
                            End If
                        Next 
                    End If
                End If
                \'If i > 100 Then GoTo 1
            Next
            If i1 > 0 Then DataTables(TableN).Save
            \'Forms("Developer").Controls("Label_Time").Text = "最后更新:" & Format(Date.Now, "G")
        Catch ex As exception 
            msgbox(ex.message) 
            \'MessageBox.Show("Weekly Machine Schdule.xlsx 导入过程出现问题的行:" & i & ",对应的列名为:" & cn)
            \'MessageBox.Show("导入失败!", "通知!")
        End Try
        1:
      
        SystemReady = True
        App.quit
    End If
    If DataTables.Contains("Data") = False Then
        DataTables.Load("Data")
    End If 
    Dim dt1 As DataTable = DataTables("Data") 
    Dim dr1 As DataRow = DataTables("Data").Find("文件更新_文件名 = \'" & ff & "\'")
    
    If dr1 Is Nothing Then
        Dim dr1a As DataRow = DataTables("Data").AddNew
        dr1a("文件更新_文件名") = ff
        dr1a("文件更新_时间") = Date.Now
        dr1a.Save
    Else 
        dr1("文件更新_时间") = Date.Now
        dr1.Save
    End If
    
    DataTables(TableN).ResumeRedraw \'屏幕恢复刷新
    Tables(TableN).Sort = "PartNumber"
    Tables("Data").Sort = "文件更新_时间 Desc"
End If
--  作者：有点蓝
--  发布时间：2023/8/22 8:42:00
--  
试试使用数据源的方式读取execl数据：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=52744
--  作者：creastzh
--  发布时间：2023/8/23 5:47:00
--  
这个是使用SQL操作Excel 填写数据到Excel，我想要的是高速从Excel 将数据读入Foxtable表

以下是引用有点蓝在2023/8/22 8:42:00的发言：
试试使用数据源的方式读取execl数据：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=52744

--  作者：有点蓝
--  发布时间：2023/8/23 8:29:00
--  
这个就是可以使用sql读取execl数据导入Foxtable。有测试过吗？
--  作者：creastzh
--  发布时间：2023/8/24 5:55:00
--  
这两天我仔细测试一下，谢谢