Foxtable(狐表) → 用户栏目 → 专家坐堂 → 从excel中交换数据


  共有2573人关注过本帖树形打印复制链接

主题：从excel中交换数据
帅哥哟，离线，有人找我吗？
creastzh
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：298 积分：2198 威望：0 精华：0 注册：2023/1/11 7:15:00 		从excel中交换数据  发帖心情 Post By：2023/8/22 8:22:00 [只看该作者]

我每日需要大量交换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
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：110758 积分：563716 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2023/8/22 8:42:00 [只看该作者]

试试使用数据源的方式读取execl数据：http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=52744

 回到顶部
帅哥哟，离线，有人找我吗？
creastzh
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：298 积分：2198 威望：0 精华：0 注册：2023/1/11 7:15:00 		  发帖心情 Post By：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


 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：110758 积分：563716 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2023/8/23 8:29:00 [只看该作者]

这个就是可以使用sql读取execl数据导入Foxtable。有测试过吗？

 回到顶部
帅哥哟，离线，有人找我吗？
creastzh
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：童狐 帖子：298 积分：2198 威望：0 精华：0 注册：2023/1/11 7:15:00 		  发帖心情 Post By：2023/8/24 5:55:00 [只看该作者]

这两天我仔细测试一下，谢谢

 回到顶部
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.08203 秒, 4 次数据查询