数据量稍微一大就内存不够用 大神来助

wuxianyu86

正好今天有空  学习了18楼 LYM123 的代码 ，用dir获取文件名称修改了一下收集数据，
个人感觉所有数据放到一张表里面更容易分析，通过筛选，一样能看到不同项目的数据，没必要分开。
Sub 收集数据2()
On Error Resume Next

n = 2
ReDim tempdata(2 To 5000, 1 To 4)
datapth = ""
datapth = (CreateObject("Shell.Application").BrowseForFolder(0, "请选择源文件夹", 0, "").Self.Path & "\")
t = Timer
If datapth = "" Then Exit Sub
fn = Dir(datapth & "*.xls?") '获取文件内的文件名
[A1:D1] = Array("日期", "项目", "测值", "源数据文件名")
For i = 2 To 10000
If fn <> "" Then
Path = datapth & fn '源文件路径
Set datawb = GetObject(Path)
mylastrow = Range("A65535").End(xlUp).Row
datalastrow = datawb.Sheets(1).Range("a65535").End(xlUp).Row

For j = 2 To datalastrow
tempdata(n, 1) = Format(datawb.Sheets(1).Cells(1, 1), "YYYY-MM-DD") '日期
tempdata(n, 2) = datawb.Sheets(1).Cells(j, 1) '测量项目
tempdata(n, 3) = datawb.Sheets(1).Cells(j, 2) '测值
tempdata(n, 4) = datawb.Name '文件名
n = n + 1
Next j
datawb.Close '关闭文件
fn = Dir '获取下一个文件名
Else
Exit For
End If
Next i
Range("A2:D5000") = tempdata


MsgBox Timer - t & "秒完成"
End Sub

wuxianyu86

wuxianyu86 发表于 2018-10-11 14:38
正好今天有空  学习了18楼 LYM123 的代码 ，用dir获取文件名称修改了一下收集数据，
个人感觉所有数据放到 ...

这种方式还是要打开工作薄，速度还是慢！！！

hexaking

wuxianyu86 发表于 2018-10-11 14:38
正好今天有空  学习了18楼 LYM123 的代码 ，用dir获取文件名称修改了一下收集数据，
个人感觉所有数据放到 ...

有心了! 主要是我的文件每天一个 放一起很乱

hexaking

LMY123 发表于 2018-10-11 09:42
Sub ADO_多薄首表_合并_无标题行()
    Range("A2:Z1048576") = ""
    Set conn = CreateObject("adod ...

老师 出现这个错误什么情况

LMY123

hexaking 发表于 2018-10-13 18:58
老师 出现这个错误什么情况

上传你出错的附件吧

hexaking

LMY123 发表于 2018-10-14 09:15
上传你出错的附件吧

是我放的位置不对吗 无法执行宏

LMY123

hexaking 发表于 2018-10-14 10:52
是我放的位置不对吗 无法执行宏

数据整理.rar (1.61 MB, 下载次数: 30)

2018-10-14 11:51 上传

点击文件名下载附件

hexaking

LMY123 发表于 2018-10-14 11:51

谢谢 大神 学习中....