[函数] vlisp操作Excel百万数据
;以数组+字典 技术可以实现对数据的增删改查等;这些数据可以转换成lisp数据;这样就可以用Excel成为你的数据库,速度还是很快的
(defun c:tt1(/ a e)
(vl-load-com)
(if(setq e(vlax-get-object "excel.Application"))
(tt4 e)
)
(if(setq a(vlax-get-object "ket.Application"))
(tt4 a)
)
)
; 2022-9-9 和尚777 QQ 1765102082
(defun tt4 (e / arr brr colm dic e i j k key range row sht v)
(setq time(hs-jsq))
(setq dic (vlax-get-or-create-object "scripting.dictionary"))
(setq sht(vlax-get-property e "ActiveSheet"))
(setq range(vlax-get-property sht "UsedRange"));用户已使用区域
(setq arr(vlax-variant-value (vlax-get-property range "value" nil)))
(setq row(vlax-safearray-get-u-bound arr 1))
(setq colm(vlax-safearray-get-u-bound arr 2))
(setq brr(ReDim-arr row colm))
(setq i 0 k 0)
(repeat row
(setq i (1+ i))(setq j 0)
(setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))
(if(= :vlax-false (vlax-invoke-method dic "exists" key))
(progn
(setq k(1+ k))
(vlax-invoke-method dic "add" key "1")
(repeat colm
(setq j(1+ j))
(setq v(vlax-variant-value
(vlax-safearray-get-element arr i j)))
(vlax-safearray-put-element brr k j v)
)
)
)
)
(vlax-put-property range "value2" brr)
(vlax-invoke-method dic "removeall")
(vlax-release-object dic)
(hs-jsq-end time)(princ)
)
(defun ReDim-arr(r c)
(vlax-make-safearray
vlax-vbVariant
(cons 1 (1+ r))(cons 1 (1+ c))
)
)
(defun c:tt2 (/ aw e p p1 path s w ws)
(setq e(vlax-get-object "excel.Application"))
(vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦
(setq ws(vlax-get-property e "workbooks"))
(setq aw(vlax-get-property e "activeworkbook"))
(setq path(vlax-get-property aw "path"))
(setq p(vlax-invoke
(vlax-create-object "scripting.filesystemobject" )
'getfolder path ))
(vlax-for x (vlax-get-property p "files")
(setq s(vlax-get-property x "name"))
(if(not(wcmatch s "*副本*"))
(progn
(setq w(vlax-invoke-method ws "open" x))
(setq p1(vlax-get-property w "name"));a1单元格写入文件名
(vlax-put-property
(vlax-get-property
(vlax-get-property
(vlax-get-property w "sheets" )
"item" 1
)
"range" "a1"
)
"value2" p1
)
(vlax-invoke-method w "close" :vlax-true)
)
)
)
(vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗
) ;xls文件只能存6w多行数据
;xlsx能存100w行
;vlisp操作Excel百万数据
;以数组+字典 技术实现对数据的增删改查,让Excel成为数据库
;最重要的是这些数据可以转换成lisp数据
;附件中有测试文件
;测试前需要先用Excel打开hs777副本.xlsm文件,
;此例是对A列去重,保留同一行的数据
(defun c:tt1(/ a e)
(vl-load-com)
(if(setq e(vlax-get-object "excel.Application"))
(tt4 e)
)
(if(setq a(vlax-get-object "ket.Application"))
(tt4 a)
)
)
; 2022-9-9 和尚777 QQ 1765102082
(defun tt4 (e / arr brr colm dic e i j k key range row sht v)
(setq time(hs-jsq))
(setq dic (vlax-get-or-create-object "scripting.dictionary"))
(setq sht(vlax-get-property e "ActiveSheet"))
(setq range(vlax-get-property sht "UsedRange"));用户已使用区域
(setq arr(vlax-variant-value (vlax-get-property range "value" nil)))
(setq row(vlax-safearray-get-u-bound arr 1))
(setq colm(vlax-safearray-get-u-bound arr 2))
(setq brr(ReDim-arr row colm))
(setq i 0 k 0)
(repeat row
(setq i (1+ i))(setq j 0)
(setq key(vlax-variant-value(vlax-safearray-get-element arr i 1)))
(if(= :vlax-false (vlax-invoke-method dic "exists" key))
(progn
(setq k(1+ k))
(vlax-invoke-method dic "add" key "1")
(repeat colm
(setq j(1+ j))
(setq v(vlax-variant-value
(vlax-safearray-get-element arr i j)))
(vlax-safearray-put-element brr k j v)
)
)
)
)
(vlax-put-property range "value2" brr)
(vlax-invoke-method dic "removeall")
(vlax-release-object dic)
(hs-jsq-end time) (princ)
)
(defun ReDim-arr(r c)
(vlax-make-safearray
vlax-vbVariant
(cons 1 (1+ r))(cons 1 (1+ c))
)
)
;批量操作excel文件
(defun c:tt2 (/ aw e p p1 path s w ws)
(setq e(vlax-get-object "excel.Application"))
(vlax-put-property e "DisplayAlerts" :vlax-False);关闭警告弹窗,如果程序运行中断自己想办法恢复哦
(setq ws(vlax-get-property e "workbooks"))
(setq aw(vlax-get-property e "activeworkbook"))
(setq path(vlax-get-property aw "path"))
(setq p(vlax-invoke
(vlax-create-object "scripting.filesystemobject" )
'getfolder path ))
(vlax-for x (vlax-get-property p "files")
(setq s(vlax-get-property x "name"))
(if(not(wcmatch s "*副本*"))
(progn
(setq w(vlax-invoke-method ws "open" x))
(setq p1(vlax-get-property w "name"));a1单元格写入文件名
(vlax-put-property
(vlax-get-property
(vlax-get-property
(vlax-get-property w "sheets" )
"item" 1
)
"range" "a1"
)
"value2" p1
)
(vlax-invoke-method w "close" :vlax-true)
)
)
)
(vlax-put-property e "DisplayAlerts" :vlax-true);恢复警告弹窗
)
(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
)
页:
[1]