vlisp以数组读写excel 超快
本帖最后由 和尚777 于 2022-12-16 16:56 编辑[*]论坛里有很多读写Excel数据的代码,大多是循环逐个读写,速度很慢
[*]Excel vba操作数组是非常方便快速的
[*]vlisp操作数组或许可以做到像Excel vba那样快速操作数据
[*]附件有我写的几个函数以数组读写Excel数据,百万数据3秒左右
下面是源码
不缺函数! ket是WPS的app名,改成Excel就行!
;vlisp读写excel 超快
;类库函数我注释了,不需要加载,兼容WPS
; 2022-9-6 hs777
(defun c:tt (/ lst time)
(setq time(hs-jsq))
(princ "\n数据构建时间")
(setq lst(tt-t1 10 50));
(hs-jsq-end time)
(setq e(vlax-get-object "Excel.Application")) ;ket.Application
;(setq sht(E-Get-ActiveSheet e))
(setq sht(vlax-get-property e "ActiveSheet"))
(princ "\n数据写入excel时间")
(setq time(hs-jsq))
(E-Lst-2-Range sht "a1" lst)
(hs-jsq-end time)
(setq time(hs-jsq))
(princ "\n读取excel数据时间")
(setq newlst(E-Get-Range-Value (vlax-get-propertysht "UsedRange")))
(hs-jsq-end time)
(princ)
);读取
(vl-load-com)
(defun c:tt2()
(setq time(hs-jsq))
(princ "\n读取excel数据时间")
(setq e(vlax-get-object "Excel.Application")) ;ket.Application
(setq sht(vlax-get-property e "ActiveSheet"))
(setq newlst(E-Get-Range-Value (vlax-get-property sht "UsedRange")))
(hs-jsq-end time)
);写入函数
;(E-Lst-2-Range sht "a1" (tt-t1 1 1))
;(E-Lst-2-Range sht "c2" (tt-t1 10 10000));百万数据
;(E-Lst2Range 工作表对象 "c2" lst)
;二维lst表数据写入Excel单元格,写入成功返回T
(defun E-Lst-2-Range(sht a1 lst / arr c r range)
;可以不加载Excel类库函数,
;注释部分get,put,invoke 3个函数 完全代替类库
(if(and sht a1 lst
(setq arr(hs-lst2arr2 lst))
;(setq a1(E-Get-Range sht a1))
(setq a1(vlax-get-property sht "range" a1))
(setq r(length lst))
(setq c(length (car lst)))
;(setq range (E-Get-Resize a1 r c))
(setq range(vlax-get-property a1 "resize" r c))
)
(progn
;(E-Put-Value2 range arr)
(vlax-put-property range "value2" arr)
t
)
)
);转换函数
;(setq lst '((1 5 6)(1 2 3)))
;二维lst表转二维变体数组
;返回数组
(defun hs-Lst2Arr2(lst / a c r)
(if (and lst (car(setq a(car lst)))
(listp a)(setq c(length a))
(vl-every '(lambda(x)(= c x))(mapcar 'length lst))
)
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbVariant
(cons 0 (1- (length lst)))(cons 1 c)
) lst)
)
);读取函数
;获取Excel单元格区域的值
;一个单元格返回一个值,一片区域返回二维lst表
(defun E-Get-Range-Value(range / a arr)
(if(and range
;(setq arr(e-get-value range))
(setq arr(vlax-get-property range "value" nil))
)
(progn
(if (< 8000(vlax-variant-type arr))
(progn
(setq a(vlax-safearray->list(vlax-variant-value arr)))
(mapcar '(lambda(x)(mapcar 'vlax-variant-value x))a)
)
(progn
(vlax-variant-value arr)
)
)
)
)
)
;测试函数
;构建二维lst表
(defun tt-t1(r c / a i s)
(setq i 0 s nil)
(repeat c
(setq a nil)
(repeat r
(setq a(cons (setq i(1+ i)) a))
)
(setq s(cons (reverse a) s))
)(setq s(reverse s))
)
(defun hs-jsq ()(setq $timebe(getvar "millisecs")))
(defun hs-jsq-end (time / tt) ;计时器结束
(or time (setq time $timebe))
(setq tt(- (getvar "millisecs") time))
(print(strcat"程序运行时间为："(rtos(* 0.00000001(* tt 86400))2 4)"秒"))
tt
)
[*]
本帖最后由 nyistjz 于 2022-9-7 00:24 编辑
e-xl24HourClock
e-xl24HourClock
e-AccrInt
E-Get-ActiveSheet
E-Get-Range
E-Get-Resize
E-Put-Value2
e-get-value
缺少一些关键函数的定义！ 本帖最后由 vip-happy 于 2023-1-10 11:44 编辑
现学没学会，写入不成功，麻烦看一下怎么回事
(defun Lst2Range (fn lst / e rg sh tp ws)
(setq e(vlax-get-object "excel.Application")
ws(vlax-invoke-method (vlax-get-property e "workbooks") "open"(findfile fn))
sh(vlax-get-property (vlax-get-property ws "sheets") "item" 1)
tp(vlax-get-property sh "range" "a1")
rg(vlax-get-property tp "resize" (length lst) (length(car lst)))
)(vlax-put-property rg "value2" (hs-Lst2Arr2 lst))
(vlax-invoke-method ws "close" :vlax-true)
) cchessbd 发表于 2022-10-9 20:36
老大太牛了。但是我看不懂额。。。我测了一下，可以读取，也可以写入。
能不能提供一个调用列子，比方说读 ...
哦，我明白了，这个已经全部读取到newlst表了，现在只需要对newlst表处理就行了。
感谢大大！感谢大大！感谢大大！感谢大大！感谢大大！ 很厉害，感谢楼主分享，学习了 支持一下，看着速度确实很快，是用多维度数组做的吗？ 能够支持WPS嘛 收藏成功66666 很厉害，感谢楼主分享，学习了 感谢共享资料！ 感谢分享！ 烟盒迷唇 发表于 2022-9-7 06:18
能够支持WPS嘛
"ket.Application" 应该支持,有些属性方法参数可能不一样