找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 799|回复: 1

[原创] Excel自动填充

[复制链接]
发表于 2021-7-2 23:00:42 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
  1. (defun $excel-zi-dong-tian-chong$ (xlapp     sh-n      rang-start
  2.            c-cz       XlAutoFillType
  3.            lst       /         co
  4.            nums       rang-end  row
  5.            rows       strs      xlsheet
  6.           )
  7.           ;自动填充
  8.           ;xlapp             excel的对象
  9.           ;sh-n              sheet的表名字
  10.           ;rang-start        起始单元格,字串格式
  11.           ;c-cz              参照列,用来计算最大行的行号
  12.           ;XlAutoFillType    填充模式
  13.           ;lst               预留参数
  14.           ;($excel-zi-dong-tian-chong$  nil "Sheet1" "C1" "A65536" 6 NIL)
  15.   (or XlAutoFillType (setq XlAutoFillType 6))
  16.   (or c-cz (setq c-cz "A65536"))  ;参照列,用来计算最下面哪一行的行号
  17.   (or xlapp (setq xlapp ($xlapp-New$ NIL nil nil))) ;EXCEL对象
  18.   (setq  xlsheet
  19.    (vl-catch-all-apply
  20.      'vlax-get-property
  21.      (list (vl-catch-all-apply
  22.        'vlax-get-property
  23.        (list (vl-catch-all-apply
  24.          'vlax-get-property
  25.          (list xlapp 'activeworkbook)
  26.        )
  27.        'Sheets
  28.        )
  29.      )
  30.      'Item
  31.      sh-n
  32.      )
  33.    )
  34.   )          ;根据传入进来的表名字获取表对象
  35.   (cond  ((and rows (= (type rows) 'str) (= (type (read rows)) 'int))
  36.           ;传入进来是字串格式,同时read后是int格式
  37.    t
  38.   )
  39.   ((and rows (= (type (read rows)) 'int)) ;传入进来的就是int格式
  40.    (setq rows (vl-princ-to-string rows)) ;转换为字串格式
  41.   )
  42.   (t
  43.    (setq rows (vl-princ-to-string
  44.           (vlax-get-property
  45.       (vlax-get-property
  46.         (msxlp-get-range xlsheet c-cz)
  47.         'End
  48.         3
  49.       )
  50.       'Row
  51.           )
  52.         )
  53.    )        ;自动根据参照列计算最大行的行号
  54.   )
  55.   )          ;填充的最大行数
  56.   (setq nums nil)
  57.   (setq  strs (MAPCAR 'vl-list->string
  58.          (mapcar 'list (vl-string->list rang-start))
  59.        )
  60.   )          ;转为字串表
  61.   (setq strs (reverse strs))    ;倒置
  62.   (while (and strs (= (type (read (car strs))) 'int))
  63.     (setq nums (cons (car strs) nums))  ;找到数字,其实就是起始行号
  64.     (setq strs (cdr strs))
  65.   )
  66.   (setq co (apply 'strcat (reverse strs))) ;得到起始列号
  67.   (setq row (apply 'strcat (reverse nums))) ;得到起始行号
  68.   (and rang-start
  69.        co
  70.        rows
  71.        (setq rang-end (strcat rang-start ":" co rows))
  72.   )          ;计算填充的最大行号
  73.   (vl-catch-all-apply
  74.     'vlax-invoke-method
  75.     (LIST (vl-catch-all-apply
  76.       'msxlp-get-range
  77.       (list xlsheet rang-start)
  78.     )
  79.     'AutoFill
  80.     (vl-catch-all-apply
  81.       'msxlp-get-range
  82.       (list xlsheet rang-end)
  83.     )
  84.     XlAutoFillType
  85.     )
  86.   )          ;执行填充
  87. )

Excel自动填充.gif
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 226个

财富等级: 日进斗金

发表于 2021-7-3 08:48:04 | 显示全部楼层
谢谢分享!!!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-15 14:01 , Processed in 0.391141 second(s), 33 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表