[函数] vlisp操作Excel百万数据

admin

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

1. (defun c:tt1(/ a e)
2.   (vl-load-com)
3.   (if(setq e(vlax-get-object "excel.Application"))
4.     (tt4 e)
5.   )
6.   (if(setq a(vlax-get-object "ket.Application"))
7.     (tt4 a)
8.   )
9. )
10. ; 2022-9-9 和尚777 QQ 1765102082
11. (defun tt4 (e / arr brr colm dic e i j k key range row sht v)
12.   (setq time(hs-jsq))
13.   (setq dic (vlax-get-or-create-object "scripting.dictionary"))
14.   (setq sht(vlax-get-property e "ActiveSheet"))
15.   (setq range(vlax-get-property sht "UsedRange"));用户已使用区域
16.   (setq arr(vlax-variant-value (vlax-get-property range "value" nil)))
17.   (setq row(vlax-safearray-get-u-bound arr 1))
18.   (setq colm(vlax-safearray-get-u-bound arr 2))
19.   (setq brr(ReDim-arr row colm))
20.   (setq i 0 k 0)
21.   (repeat row
22.     (setq i (1+ i))(setq j 0)
23.     (setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))
24.     (if(= :vlax-false (vlax-invoke-method dic "exists" key))
25.       (progn
26.         (setq k(1+ k))
27.         (vlax-invoke-method dic "add" key "1")
28.         (repeat colm
29.           (setq j(1+ j))
30.           (setq v(vlax-variant-value
31.                  (vlax-safearray-get-element arr i j)))
32.           (vlax-safearray-put-element brr k j v)
33.         )
34.       )
35.     )
36.   )
37.   (vlax-put-property range "value2" brr)
38.   (vlax-invoke-method dic "removeall")
39.   (vlax-release-object dic)
40. (hs-jsq-end time)  (princ)
41. )
43. (defun ReDim-arr(r c)
44.   (vlax-make-safearray
45.     vlax-vbVariant
46.     (cons 1 (1+ r))(cons 1 (1+ c))
47.   )
48. )
50. (defun c:tt2 (/ aw e p p1 path s w ws)
51.   (setq e(vlax-get-object "excel.Application"))
52.   (vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦
53.   (setq ws(vlax-get-property e "workbooks"))
54.   (setq aw(vlax-get-property e "activeworkbook"))
55.   (setq path(vlax-get-property aw "path"))
56.   (setq p(vlax-invoke
57.     (vlax-create-object "scripting.filesystemobject" )
58.     'getfolder path ))
59.   (vlax-for x (vlax-get-property p "files")
60.     (setq s(vlax-get-property x "name"))
61.     (if(not(wcmatch s "*副本*"))
62.       (progn
63.         (setq w(vlax-invoke-method ws "open" x))
64.         (setq p1(vlax-get-property w "name"));a1单元格写入文件名
65.         (vlax-put-property
66.           (vlax-get-property
67.             (vlax-get-property
68.               (vlax-get-property w "sheets" )
69.               "item" 1
70.             )
71.             "range" "a1"
72.           )
73.           "value2" p1
74.         )
75.         (vlax-invoke-method w "close" :vlax-true)
76.       )
77.     )
78.   )
79.   (vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗
80. )

复制代码

admin

1. ;xls文件只能存6w多行数据
2. ;xlsx能存100w行
4. ;vlisp操作Excel百万数据
5. ;以数组+字典 技术实现对数据的增删改查,让Excel成为数据库
6. ;最重要的是这些数据可以转换成lisp数据
8. ;附件中有测试文件
9. ;测试前需要先用Excel打开hs777副本.xlsm文件,
11. ;此例是对A列去重,保留同一行的数据
12. (defun c:tt1(/ a e)
13.         (vl-load-com)
14.         (if(setq e(vlax-get-object "excel.Application"))
15.                 (tt4 e)
16.         )
17.         (if(setq a(vlax-get-object "ket.Application"))
18.                 (tt4 a)
19.         )
20. )
21. ; 2022-9-9 和尚777 QQ 1765102082
22. (defun tt4 (e / arr brr colm dic e i j k key range row sht v)
23.         (setq time(hs-jsq))
24.         (setq dic (vlax-get-or-create-object "scripting.dictionary"))
25.         (setq sht(vlax-get-property e "ActiveSheet"))
26.         (setq range(vlax-get-property sht "UsedRange"));用户已使用区域
27.         (setq arr(vlax-variant-value (vlax-get-property range "value" nil)))
28.         (setq row(vlax-safearray-get-u-bound arr 1))
29.         (setq colm(vlax-safearray-get-u-bound arr 2))
30.         (setq brr(ReDim-arr row colm))
31.         (setq i 0 k 0)
32.         (repeat row
33.                 (setq i (1+ i))(setq j 0)
34.                 (setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))
35.                 (if(= :vlax-false (vlax-invoke-method dic "exists" key))
36.                         (progn
37.                                 (setq k(1+ k))
38.                                 (vlax-invoke-method dic "add" key "1")
39.                                 (repeat colm
40.                                         (setq j(1+ j))
41.                                         (setq v(vlax-variant-value
42.                                                                  (vlax-safearray-get-element arr i j)))
43.                                         (vlax-safearray-put-element brr k j v)
44.                                 )
45.                         )
46.                 )
47.         )
48.         (vlax-put-property range "value2" brr)
49.         (vlax-invoke-method dic "removeall")
50.         (vlax-release-object dic)
51. (hs-jsq-end time)        (princ)
52. )
54. (defun ReDim-arr(r c)
55.         (vlax-make-safearray
56.                 vlax-vbVariant
57.                 (cons 1 (1+ r))(cons 1 (1+ c))
58.         )
59. )
64. ;批量操作excel文件
65. (defun c:tt2 (/ aw e p p1 path s w ws)
66.         (setq e(vlax-get-object "excel.Application"))
67.         (vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦
68.         (setq ws(vlax-get-property e "workbooks"))
69.         (setq aw(vlax-get-property e "activeworkbook"))
70.         (setq path(vlax-get-property aw "path"))
71.         (setq p(vlax-invoke
72.                 (vlax-create-object "scripting.filesystemobject" )
73.                 'getfolder path ))
74.         (vlax-for x (vlax-get-property p "files")
75.                 (setq s(vlax-get-property x "name"))
76.                 (if(not(wcmatch s "*副本*"))
77.                         (progn
78.                                 (setq w(vlax-invoke-method ws "open" x))
79.                                 (setq p1(vlax-get-property w "name"));a1单元格写入文件名
80.                                 (vlax-put-property
81.                                         (vlax-get-property
82.                                                 (vlax-get-property
83.                                                         (vlax-get-property w "sheets" )
84.                                                         "item" 1
85.                                                 )
86.                                                 "range" "a1"
87.                                         )
88.                                         "value2" p1
89.                                 )
90.                                 (vlax-invoke-method w "close" :vlax-true)
91.                         )
92.                 )
93.         )
94.         (vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗
95. )
97. (defun hs-jsq ()(setq $timebe(getvar "millisecs")))
98. (defun hs-jsq-end (time / tt) ;计时器结束
99.         (or time (setq time $timebe))
100.         (setq tt(- (getvar "millisecs") time))
101.         (print(strcat"程序运行时间为："(rtos(* 0.00000001(* tt 86400))2 4)"秒"))
102.         tt
103. )

复制代码