vlisp操作Excel百万数据

和尚777

vlisp操作Excel百万数据

;以数组+字典 技术可以实现对数据的增删改查等;这些数据可以转换成lisp数据
;这样就可以用Excel成为你的数据库,速度还是很快的

    附件中有测试文件
    测试前需要先用Excel打开 hs777副本.xlsm
    还附带了个vlisp批量操作Excel文件
      此例是对A列去重,保留同一行的数据

2. (defun c:tt1(/ a e)
   
3.   (vl-load-com)
   
4.   (if(setq e(vlax-get-object "excel.Application"))
   
5.     (tt4 e)
   
6.   )
   
7.   (if(setq a(vlax-get-object "ket.Application"))
   
8.     (tt4 a)
   
9.   )
   
10. )
    
11. ; 2022-9-9 和尚777 QQ 1765102082
    
12. (defun tt4 (e / arr brr colm dic e i j k key range row sht v)
    
13.   (setq time(hs-jsq))
    
14.   (setq dic (vlax-get-or-create-object "scripting.dictionary"))
    
15.   (setq sht(vlax-get-property e "ActiveSheet"))
    
16.   (setq range(vlax-get-property sht "UsedRange"));用户已使用区域
    
17.   (setq arr(vlax-variant-value (vlax-get-property range "value" nil)))
    
18.   (setq row(vlax-safearray-get-u-bound arr 1))
    
19.   (setq colm(vlax-safearray-get-u-bound arr 2))
    
20.   (setq brr(ReDim-arr row colm))
    
21.   (setq i 0 k 0)
    
22.   (repeat row
    
23.     (setq i (1+ i))(setq j 0)
    
24.     (setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))
    
25.     (if(= :vlax-false (vlax-invoke-method dic "exists" key))
    
26.       (progn
    
27.         (setq k(1+ k))
    
28.         (vlax-invoke-method dic "add" key "1")
    
29.         (repeat colm
    
30.           (setq j(1+ j))
    
31.           (setq v(vlax-variant-value
    
32.                  (vlax-safearray-get-element arr i j)))
    
33.           (vlax-safearray-put-element brr k j v)
    
34.         )
    
35.       )
    
36.     )
    
37.   )
    
38.   (vlax-put-property range "value2" brr)
    
39.   (vlax-invoke-method dic "removeall")
    
40.   (vlax-release-object dic)
    
41. (hs-jsq-end time)  (princ)
    
42. )
    
43. 
    
44. (defun ReDim-arr(r c)
    
45.   (vlax-make-safearray
    
46.     vlax-vbVariant
    
47.     (cons 1 (1+ r))(cons 1 (1+ c))
    
48.   )
    
49. )

(defun c:tt1(/ a e)<br />   (vl-load-com)<br />   (if(setq e(vlax-get-object "excel.Application"))<br />     (tt4 e)<br />   )<br />   (if(setq a(vlax-get-object "ket.Application"))<br />     (tt4 a)<br />   )<br /> )<br /> ; 2022-9-9 和尚777 QQ 1765102082<br /> (defun tt4 (e / arr brr colm dic e i j k key range row sht v)<br />   (setq time(hs-jsq))<br />   (setq dic (vlax-get-or-create-object "scripting.dictionary"))<br />   (setq sht(vlax-get-property e "ActiveSheet"))<br />   (setq range(vlax-get-property sht "UsedRange"));用户已使用区域<br />   (setq arr(vlax-variant-value (vlax-get-property range "value" nil)))<br />   (setq row(vlax-safearray-get-u-bound arr 1))<br />   (setq colm(vlax-safearray-get-u-bound arr 2))<br />   (setq brr(ReDim-arr row colm))<br />   (setq i 0 k 0)<br />   (repeat row<br />     (setq i (1+ i))(setq j 0)<br />     (setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))<br />     (if(= :vlax-false (vlax-invoke-method dic "exists" key))<br />       (progn <br />         (setq k(1+ k))<br />         (vlax-invoke-method dic "add" key "1")<br />         (repeat colm<br />           (setq j(1+ j))<br />           (setq v(vlax-variant-value<br />                  (vlax-safearray-get-element arr i j)))<br />           (vlax-safearray-put-element brr k j v)<br />         )<br />       )<br />     )<br />   )<br />   (vlax-put-property range "value2" brr)<br />   (vlax-invoke-method dic "removeall")<br />   (vlax-release-object dic)<br /> (hs-jsq-end time)  (princ)<br /> )<br /> <br /> (defun ReDim-arr(r c)<br />   (vlax-make-safearray<br />     vlax-vbVariant<br />     (cons 1 (1+ r))(cons 1 (1+ c))<br />   )<br /> )

• ;批量操作excel文件
  

2. (defun c:tt2 (/ aw e p p1 path s w ws)
   
3.   (setq e(vlax-get-object "excel.Application"))
   
4.   (vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦
   
5.   (setq ws(vlax-get-property e "workbooks"))
   
6.   (setq aw(vlax-get-property e "activeworkbook"))
   
7.   (setq path(vlax-get-property aw "path"))
   
8.   (setq p(vlax-invoke
   
9.     (vlax-create-object "scripting.filesystemobject" )
   
10.     'getfolder path ))
    
11.   (vlax-for x (vlax-get-property p "files")
    
12.     (setq s(vlax-get-property x "name"))
    
13.     (if(not(wcmatch s "*副本*"))
    
14.       (progn
    
15.         (setq w(vlax-invoke-method ws "open" x))
    
16.         (setq p1(vlax-get-property w "name"));a1单元格写入文件名
    
17.         (vlax-put-property
    
18.           (vlax-get-property
    
19.             (vlax-get-property
    
20.               (vlax-get-property w "sheets" )
    
21.               "item" 1
    
22.             )
    
23.             "range" "a1"
    
24.           )
    
25.           "value2" p1
    
26.         )
    
27.         (vlax-invoke-method w "close" :vlax-true)
    
28.       )
    
29.     )
    
30.   )
    
31.   (vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗
    
32. )

(defun c:tt2 (/ aw e p p1 path s w ws)<br />   (setq e(vlax-get-object "excel.Application"))<br />   (vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦<br />   (setq ws(vlax-get-property e "workbooks"))<br />   (setq aw(vlax-get-property e "activeworkbook"))<br />   (setq path(vlax-get-property aw "path"))<br />   (setq p(vlax-invoke <br />     (vlax-create-object "scripting.filesystemobject" )<br />     'getfolder path ))<br />   (vlax-for x (vlax-get-property p "files")<br />     (setq s(vlax-get-property x "name"))<br />     (if(not(wcmatch s "*副本*"))<br />       (progn <br />         (setq w(vlax-invoke-method ws "open" x))<br />         (setq p1(vlax-get-property w "name"));a1单元格写入文件名<br />         (vlax-put-property<br />           (vlax-get-property<br />             (vlax-get-property<br />               (vlax-get-property w "sheets" )<br />               "item" 1<br />             )<br />             "range" "a1"<br />           )<br />           "value2" p1<br />         )<br />         (vlax-invoke-method w "close" :vlax-true)<br />       )<br />     )<br />   )<br />   (vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗<br /> )

白色微風1991

學習了，感謝共享資料！

479274135

锋十七 发表于 2023-4-3 12:54
谢谢楼主的分享
学到了很多，也解决了我的难题

厉害   咱这小卡拉米  完全看不懂

你有种再说一遍

有没有人闲着蛋疼去用这个方法实现平衡二叉树和hashmap,不过怎么提供hashcode给hashmap呢?

vlisp2012

非常好的程序，多谢分享！

guosheyang

感谢共享资料！

没有昵称呀

学习了，感谢共享资料！

烟盒迷唇

非常厉害了

cxjcqu

厉害了~很有用

自贡黄明儒

数组+字典， 是VBA的精华所在，被您搬到lisp来了。

zjy2999

感谢共享资料！

hhh454

感谢分享，学习了