vlisp以数组读写excel 超快

和尚777

• 论坛里有很多读写Excel数据的代码,大多是循环逐个读写,速度很慢
• Excel vba操作数组是非常方便快速的
• vlisp操作数组或许可以做到像Excel vba那样快速操作数据
• 附件有我写的几个函数以数组读写Excel数据,百万数据3秒左右
  

    下面是源码
         不缺函数! ket是WPS的app名,改成Excel就行!
;vlisp读写excel 超快
;类库函数我注释了,不需要加载,兼容WPS

2. ; 2022-9-6 hs777
   
3. (defun c:tt (/ lst time)
   
4. 
   
5.         (setq time(hs-jsq))
   
6.         (princ "\n数据构建时间")
   
7.         (setq lst(tt-t1 10 50));
   
8.         (hs-jsq-end time)
   
9. 
   
10.         (setq e(vlax-get-object "Excel.Application")) ;ket.Application
    
11.         ;(setq sht(E-Get-ActiveSheet e))
    
12.         (setq sht(vlax-get-property e "ActiveSheet"))
    
13.         (princ "\n数据写入excel时间")
    
14.         (setq time(hs-jsq))
    
15.         (E-Lst-2-Range sht "a1" lst)
    
16.         (hs-jsq-end time)
    
17. 
    
18.         (setq time(hs-jsq))
    
19.         (princ "\n读取excel数据时间")
    
20.         (setq newlst(E-Get-Range-Value (vlax-get-property  sht "UsedRange")))
    
21.         (hs-jsq-end time)
    
22.         (princ)
    
23. )

; 2022-9-6 hs777<br /> (defun c:tt (/ lst time)<br /> <br />         (setq time(hs-jsq))<br />         (princ "\n数据构建时间")<br />         (setq lst(tt-t1 10 50));<br />         (hs-jsq-end time)<br /> <br />         (setq e(vlax-get-object "Excel.Application")) ;ket.Application<br />         ;(setq sht(E-Get-ActiveSheet e))<br />         (setq sht(vlax-get-property e "ActiveSheet"))<br />         (princ "\n数据写入excel时间")<br />         (setq time(hs-jsq))<br />         (E-Lst-2-Range sht "a1" lst)<br />         (hs-jsq-end time)<br /> <br />         (setq time(hs-jsq))<br />         (princ "\n读取excel数据时间")<br />         (setq newlst(E-Get-Range-Value (vlax-get-property  sht "UsedRange")))<br />         (hs-jsq-end time)<br />         (princ)<br /> )

;读取

2. (vl-load-com)
   
3. (defun c:tt2()
   
4.         (setq time(hs-jsq))
   
5.         (princ "\n读取excel数据时间")
   
6.         (setq e(vlax-get-object "Excel.Application")) ;ket.Application
   
7.         (setq sht(vlax-get-property e "ActiveSheet"))
   
8.         (setq newlst(E-Get-Range-Value (vlax-get-property sht "UsedRange")))
   
9.         (hs-jsq-end time)
   
10. )

(vl-load-com)<br /> (defun c:tt2()<br />         (setq time(hs-jsq))<br />         (princ "\n读取excel数据时间")<br />         (setq e(vlax-get-object "Excel.Application")) ;ket.Application<br />         (setq sht(vlax-get-property e "ActiveSheet"))<br />         (setq newlst(E-Get-Range-Value (vlax-get-property sht "UsedRange")))<br />         (hs-jsq-end time)<br /> )

;写入函数

2. ;(E-Lst-2-Range sht "a1" (tt-t1 1 1))
   
3. ;(E-Lst-2-Range sht "c2" (tt-t1 10 10000));百万数据
   
4. ;(E-Lst2Range 工作表对象 "c2" lst)
   
5. ;二维lst表数据写入Excel单元格,写入成功返回T
   
6. (defun E-Lst-2-Range(sht a1 lst / arr c r range)
   
7.         ;可以不加载Excel类库函数,
   
8.         ;注释部分get,put,invoke 3个函数 完全代替类库
   
9.         (if(and sht a1 lst
   
10.                          (setq arr(hs-lst2arr2 lst))
    
11.                          ;(setq a1(E-Get-Range sht a1))
    
12.                          (setq a1(vlax-get-property sht "range" a1))
    
13.                          (setq r(length lst))
    
14.                          (setq c(length (car lst)))
    
15.                          ;(setq range (E-Get-Resize a1 r c))
    
16.                          (setq range(vlax-get-property a1 "resize" r c))
    
17.                  )
    
18.                 (progn
    
19.                         ;(E-Put-Value2 range arr)
    
20.                         (vlax-put-property range "value2" arr)
    
21.                         t
    
22.                 )
    
23.         )
    
24. )

;(E-Lst-2-Range sht "a1" (tt-t1 1 1))<br /> ;(E-Lst-2-Range sht "c2" (tt-t1 10 10000));百万数据<br /> ;(E-Lst2Range 工作表对象 "c2" lst)<br /> ;二维lst表数据写入Excel单元格,写入成功返回T<br /> (defun E-Lst-2-Range(sht a1 lst / arr c r range)<br />         ;可以不加载Excel类库函数,<br />         ;注释部分get,put,invoke 3个函数 完全代替类库<br />         (if(and sht a1 lst <br />                          (setq arr(hs-lst2arr2 lst))<br />                          ;(setq a1(E-Get-Range sht a1))<br />                          (setq a1(vlax-get-property sht "range" a1))<br />                          (setq r(length lst))<br />                          (setq c(length (car lst)))<br />                          ;(setq range (E-Get-Resize a1 r c))<br />                          (setq range(vlax-get-property a1 "resize" r c))<br />                  )<br />                 (progn <br />                         ;(E-Put-Value2 range arr)<br />                         (vlax-put-property range "value2" arr)<br />                         t<br />                 )<br />         )<br /> )

;转换函数

2. ;(setq lst '((1 5 6)(1 2 3)))
   
3. ;二维lst表转二维变体数组
   
4. ;返回数组
   
5. (defun hs-Lst2Arr2(lst / a c r)
   
6.         (if (and lst (car(setq a(car lst)))
   
7.                                 (listp a)(setq c(length a))
   
8.                                 (vl-every '(lambda(x)(= c x))(mapcar 'length lst))
   
9.                         )
   
10.                 (vlax-safearray-fill
    
11.                         (vlax-make-safearray
    
12.                                 vlax-vbVariant
    
13.                                 (cons 0 (1- (length lst)))(cons 1 c)
    
14.                         ) lst)
    
15.         )
    
16. )

;(setq lst '((1 5 6)(1 2 3)))<br /> ;二维lst表转二维变体数组<br /> ;返回数组<br /> (defun hs-Lst2Arr2(lst / a c r)<br />         (if (and lst (car(setq a(car lst)))<br />                                 (listp a)(setq c(length a))<br />                                 (vl-every '(lambda(x)(= c x))(mapcar 'length lst))<br />                         )<br />                 (vlax-safearray-fill<br />                         (vlax-make-safearray<br />                                 vlax-vbVariant<br />                                 (cons 0 (1- (length lst)))(cons 1 c)<br />                         ) lst)<br />         )<br /> )

;读取函数

2. ;获取Excel单元格区域的值
   
3. ;一个单元格返回一个值,一片区域返回二维lst表
   
4. (defun E-Get-Range-Value(range / a arr)
   
5.         (if(and range
   
6.                          ;(setq arr(e-get-value range))
   
7.                          (setq arr(vlax-get-property range "value" nil))
   
8.                  )
   
9.                 (progn
   
10.                         (if (< 8000(vlax-variant-type arr))
    
11.                                 (progn
    
12.                                         (setq a(vlax-safearray->list(vlax-variant-value arr)))
    
13.                                         (mapcar '(lambda(x)(mapcar 'vlax-variant-value x))a)
    
14.                                 )
    
15.                                 (progn
    
16.                                         (vlax-variant-value arr)
    
17.                                 )
    
18.                         )
    
19.                 )
    
20.         )
    
21. )
    

;获取Excel单元格区域的值<br /> ;一个单元格返回一个值,一片区域返回二维lst表<br /> (defun E-Get-Range-Value(range / a arr)<br />         (if(and range <br />                          ;(setq arr(e-get-value range))<br />                          (setq arr(vlax-get-property range "value" nil))<br />                  )<br />                 (progn <br />                         (if (< 8000(vlax-variant-type arr))<br />                                 (progn <br />                                         (setq a(vlax-safearray->list(vlax-variant-value arr)))<br />                                         (mapcar '(lambda(x)(mapcar 'vlax-variant-value x))a)<br />                                 )<br />                                 (progn <br />                                         (vlax-variant-value arr)<br />                                 )<br />                         )<br />                 )<br />         )<br /> )<br />

;测试函数

2. ;构建二维lst表
   
3. (defun tt-t1(r c / a i s)
   
4.         (setq i 0 s nil)
   
5.         (repeat c
   
6.                 (setq a nil)
   
7.                 (repeat r
   
8.                         (setq a(cons (setq i(1+ i)) a))
   
9.                 )
   
10.                 (setq s(cons (reverse a) s))
    
11.         )(setq s(reverse s))
    
12. )
    
13. 
    
14. (defun hs-jsq ()(setq $timebe(getvar "millisecs")))
    
15. (defun hs-jsq-end (time / tt) ;计时器结束
    
16.         (or time (setq time $timebe))
    
17.         (setq tt(- (getvar "millisecs") time))
    
18.         (print(strcat"程序运行时间为："(rtos(* 0.00000001(* tt 86400))2 4)"秒"))
    
19.         tt
    
20. )

;构建二维lst表<br /> (defun tt-t1(r c / a i s)<br />         (setq i 0 s nil)<br />         (repeat c<br />                 (setq a nil)<br />                 (repeat r<br />                         (setq a(cons (setq i(1+ i)) a))<br />                 )<br />                 (setq s(cons (reverse a) s))<br />         )(setq s(reverse s))<br /> )<br /> <br /> (defun hs-jsq ()(setq $timebe(getvar "millisecs")))<br /> (defun hs-jsq-end (time / tt) ;计时器结束<br />         (or time (setq time $timebe))<br />         (setq tt(- (getvar "millisecs") time))<br />         (print(strcat"程序运行时间为："(rtos(* 0.00000001(* tt 86400))2 4)"秒"))<br />         tt<br /> )

• 
  

nyistjz

e-xl24HourClock
e-xl24HourClock
e-AccrInt
E-Get-ActiveSheet
E-Get-Range
E-Get-Resize
E-Put-Value2
e-get-value


缺少一些关键函数的定义！

vip-happy

现学没学会，写入不成功，麻烦看一下怎么回事

(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

cchessbd 发表于 2022-10-9 20:36
老大太牛了。但是我看不懂额。。。我测了一下，可以读取，也可以写入。
能不能提供一个调用列子，比方说读 ...

哦，我明白了，这个已经全部读取到newlst表了，现在只需要对newlst表处理就行了。
感谢大大！感谢大大！感谢大大！感谢大大！感谢大大！

hhh454

很厉害，感谢楼主分享，学习了

AndyWang

支持一下，看着速度确实很快，是用多维度数组做的吗？

烟盒迷唇

能够支持WPS嘛

liuhe

收藏成功66666

czb203

很厉害，感谢楼主分享，学习了

guosheyang

感谢共享资料！

dlfjdy

感谢分享！

和尚777

烟盒迷唇 发表于 2022-9-7 06:18
能够支持WPS嘛

"ket.Application" 应该支持,有些属性方法参数可能不一样