注册 登录
编程论坛 VB6论坛

想请教一个问题,已经问过很多专业的编程人员,但都没能解答

start1901 发布于 2018-03-10 17:48, 3717 次点击
想请教一个问题,已经问过很多专业的编程人员,可能他们都不接触vb与excel,都没给我想要的解答,至今百思不得其解
我写了一个vb的程序处理excel里的数据,
主要功能是:打开两个excel,A和B,再新建一个excel,C
A里面有8000多行的数据,我的软件根据B表里面的范围及条件,把A表中对应数据行粘贴到新表C中
复制、粘贴用的是 :
xlbook.sheets(1).cells(i,2).resize(1,6).Copy
Zlbook.sheets(1).cells(j,2).resize(1,6).Pastespical
软件运行得很正常,结果正确
但问题是:
开始时运行很快,一秒能粘贴很多行,但过一段时间软件就开始越来越慢,一秒粘贴一行,后来就几秒才粘贴一行
我写的循环很简单,反复查过不是循环导致的
前面粘贴的和后面粘贴的都差不多,不知道为什么,到后来就非常非常慢了

想请教大家,在筛查、复制、粘贴大量数据的时候是否也是这样,该怎样解决?


只有本站会员才能查看附件,请 登录
只有本站会员才能查看附件,请 登录

我上传了一个压缩包,如图,有两个excel,第一个提到的A,第二个是提到的B
再如图,软件的三个按钮,点按钮一导入第一个excel,点按钮二导入第二个excel
按钮三是开始处理,也就是慢的那部分,可否帮看一下为什么运行这么慢,(我上传的工区是vb6.0)

[此贴子已经被作者于2018-3-12 00:12编辑过]

23 回复
#2
suzhanpeng2018-03-11 09:57
提供源码吧
#3
wds12018-03-11 10:20
1、读取的execl增加以下语句  
  xlApp.Visible = False
2、保存的语句增加
 NewXls.DisplayAlerts = False
3、读取要一次性读到内存,写入也要一次性写入

你试试以上方法,数据量大的一般能提高5倍以上效率,数据量小的区别不大。


#4
xyxcc1772018-03-11 14:45
用数组,把要复制的数据据先写入数组中,一次性写入非常快,10万条数据也是瞬间。
#5
start19012018-03-12 00:11
回复 3楼 wds1
前两句明白一点,让表格不可见、警告窗口别弹出,不太明白第三句是什么意思,具体该怎样办,请指点一下
#6
start19012018-03-12 00:14
回复 2楼 suzhanpeng
提供了,帮忙看一下前两个按钮是导入,可否帮忙看一下第三个按钮为什么慢
#7
start19012018-03-12 00:53
回复 4楼 xyxcc177
想请教下,我的格子里有字符也有数字,数组应该是用什么数据类型,
是不是说复制的时候,把要复制的每个格子都放到数组里,粘贴的时候再一个一个cells的粘出来?
请教了
#8
xiangyue05102018-03-12 10:58
不用使用range整体进行复制粘贴么?
#9
start19012018-03-12 14:00
回复 8楼 xiangyue0510
我就是range整体复制,很慢
#10
wds12018-03-12 14:31
1、你导入的1号文件和2号文件不要存在C盘,保存到内存数组,同时只读取包含数据记录,可以参考以下函数
'============================================================
'  读取EXECL到内存数组【需要DAO控件,速度快-优选】
'  输入参数:execl名字、sheet名
'  输出参数:txt1内存数组【execl数据到内存数组】
'============================================================
Public Sub Load_Execl(ByVal execl_name As String, ByVal sheet_name, txt1)
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim i As Long, j As Long
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & execl_name & ";extended properties= 'Excel 8.0;HDR=YES;IMEX=1';"
  rs.Open "select * from [" + sheet_name + "$]", cn, adOpenKeyset, adLockOptimistic
  ReDim txt1(rs.RecordCount, rs.Fields.Count)
  For i = 1 To rs.Fields.Count: txt1(0, i) = rs.Fields(i - 1).Name: Next i '读第一行【首行当标题了】
  For i = 1 To rs.RecordCount '读其余行
    For j = 1 To rs.Fields.Count: txt1(i, j) = IIf(Not IsNull(rs.Fields(j - 1)), rs.Fields(j - 1), ""): Next j
    rs.MoveNext
  Next i
  Set rs = Nothing
  Set cn = Nothing
End Sub
  数据调用格式:call Load_Execl("第二个按钮导入.xlsx", "sheet1", txt1)
         call Load_Execl("第一个按钮导入done.xlsx", "D1H", txt2)

2、数据比较时,采用txt1,txt2内存数组对比,之后保存目标execl


#11
xiangyue05102018-03-12 16:24
回复 9楼 start1901
我看你的代码你用的是Cell,
我说的是Range,比如Range("A1:D2)这样
一个是一格一格,我这是一片一片
#12
start19012018-03-12 23:26
回复 11楼 xiangyue0510
我改成cells().resize(1,10)了,也就是range,但依然很慢
#13
start19012018-03-12 23:29
回复 10楼 wds1
今天想了想,会不会不是复制粘贴导致的缓慢,因为,我观察软件运行的时候,前20秒没有复制文件,可是速度也慢了下来
这是什么原因啊?
#14
wds12018-03-13 12:38
慢的原因就是I/o操作,所以建议你全部更改为内存操作。
如果你用execl的语句操作,数据量越大会越慢。

你没明白慢的本质原因,是由于I/o造成。
#15
start19012018-03-13 22:29
回复 14楼 wds1
怎样使用内存操作啊,求大神给点具体的指导,或者给段可以借鉴的代码
是不是指我要把cell里的内容放到变量里,再把变量的值赋给新表的cell,是这样么?

[此贴子已经被作者于2018-3-13 22:32编辑过]

#16
Artless2018-03-14 02:00
以下是引用start1901在2018-3-13 22:29:15的发言:

怎样使用内存操作啊,求大神给点具体的指导,或者给段可以借鉴的代码
是不是指我要把cell里的内容放到变量里,再把变量的值赋给新表的cell,是这样么?

数组
#17
wds12018-03-14 09:58
下面1,2是execl的一次性读取和保存示例,供调试和参考。另外数据量小的读取也可以直接用Excel.Application

你在比较时用内存数组,结果也用内存数组,之后保存。

1、execl读到内存数组txt1【直接调用函数,我的驱动是对xls格式的execl】
Public Sub Load_Execl(ByVal execl_name As String, ByVal sheet_name, txt1)
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset
  Dim i As Long, j As Long
  cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & execl_name & ";extended properties= 'Excel 8.0;HDR=YES;IMEX=1';"
  rs.Open "select * from [" + sheet_name + "$]", cn, adOpenKeyset, adLockOptimistic
  ReDim txt1(rs.RecordCount, rs.Fields.Count)
  For i = 1 To rs.Fields.Count: txt1(0, i) = rs.Fields(i - 1).Name: Next i '读第一行【首行当标题了】
  For i = 1 To rs.RecordCount '读其余行
    For j = 1 To rs.Fields.Count: txt1(i, j) = IIf(Not IsNull(rs.Fields(j - 1)), rs.Fields(j - 1), ""): Next j
    rs.MoveNext
    '此处如果增加显示读取行数idea语句,增加doevents
  Next i
  Set rs = Nothing
  Set cn = Nothing
End Sub
2、txt2保存到execl
Public Sub Save_Execl(txt2)
Dim nRows As Long, nColumns As Long
 Set NewXls = CreateObject("Excel.Application") '创建excel应用程序
     NewXls.SheetsInNewWorkbook = 1
 Set newbook = NewXls.Workbooks.Add '创建工作簿
 Set NewSheet = newbook.Worksheets(1) '创建工作表
     NewXls.DisplayAlerts = False  '
      
   nRows = UBound(txt1, 1)
   nColumns = UBound(txt1, 2)
      
   '导出到Excel中
   Set objRange = NewSheet.Range(NewSheet.Cells(1, 1), NewSheet.Cells(nRows, nColumns))
      objRange.Value = txt2
       NewXls.Workbooks(1).Worksheets(1).Name = "D1H"
  newbook.SaveAs FileName:="execl名"
  newbook.Close
   Set newbook = Nothing
   Set NewXls = Nothing
end sub



[此贴子已经被作者于2018-3-14 10:01编辑过]

#18
wds12018-03-16 16:29
只有本站会员才能查看附件,请 登录

今天正好空闲,把你的程序修改了一下。
1、主要修改读取部分,采用把execl直接读取到内存数组execla,之后在内存中形成临时测井数据,再保存为execl
2、比较部分,采用把execl直接读取到内存数组execla,execlb,之后在内存中比较形成新的execl,之后保存

其他说明:
1、由于不知道你的程序的具体用途,所以结果我没发验证。但你的程序刷选应该还可以优化的。
2、另外你临时保存在c盘目录的execl都没有必要,但是为了减少修改量,我几乎没有修改你的程序结构
3、测试后临时表都能输出,处理速度比你的提高不是10倍,具体自己测试。

#19
def00112018-03-16 17:10
excel里面表格的复制很简单的,效率绝对没问题:
Sheet1.Range("a1:a15").Copy Sheet2.Range("a1")
#20
start19012018-03-17 00:49
回复 18楼 wds1
得到的新表是空白的啊,我以前的程序是可以得到结果的,
但还是感谢,我在学习下你的代码吧
(软件的目的是根据表2,劈分表1,得到新表,劈分后的一个单元一个sheet)
#21
wds12018-03-17 08:03
我看了一下程序,发现了部分问题。

1、由于没有使用分层和测井表,所以复制部分应该在内存表execla和execlb复制。
2、你的execl没有"油"和"气",但是复制选项还使用了此条件,因此结果数据是空。

其他:
1、输出表也需要建立内存表,否则速度不会快。
2、输出表可以采用三维数组。
  其中增加的1维存储表名,另外的2维与复制表一致
 生成execl时,利用for将三维表转为多个2维赋值给不同sheet在统一保存。



[此贴子已经被作者于2018-3-17 10:23编辑过]

#22
wlrjgzs2018-03-17 17:21
数组就是内存表?
#23
wds12018-03-18 10:30
只有本站会员才能查看附件,请 登录

1、虽然结贴了,我也重新修改了下程序,修改后的execl处理速度,远远高于直接操作execl的处理速度。

2、程序主要实现了execl到内存的读取、在内存的操作,以及再保存为execl。

3、此程序我按照原来程序进行了简化。
  读取部分定义了一个公共子程序将execl读到内存,取消了临时execl表
  查询部分利用内存比较,主要是解决了速度慢问题,输出结果在一个二维数组中
  输出部分按照二维数组原始格式保存的,没做execl拆分和execl格式处理。

#24
start19012018-03-20 23:55
回复 23楼 wds1
抱歉啊,太忙了,几天没上网,十分感谢你的帮助,我会好好看看的,再次感谢
1