设为首页收藏本站

中国膜结构网

 找回密码
 立即注册

QQ登录

只需一步,快速开始

膜结构车棚
膜结构车棚膜结构资质国产膜材 膜结构网中国膜结构协会
查看: 37|回复: 0

快速读取Excel表格的数据 [A/VLISP›]

[复制链接]
  • TA的每日心情
    开心
    2021-6-18 10:57
  • 签到天数: 1538 天

    [LV.Master]伴坛终老

    发表于 2021-6-5 22:05 | 显示全部楼层 |阅读模式
    1. (defun get−excel−sheet−v (excelFile        sheetName
    2.           RangeStr lst      /         arr
    3.           col       col-zms  cs       DATA
    4.           fullname nm        nms      open?
    5.           rg       row      sh       sheets-morens
    6.           shs       ttt      usedrange
    7.           vvv       wb        wbs      xl
    8.          )
    9.           ;excelFile xls文件路径
    10.           ;sheetName 表名字
    11.           ;RangeStr 数据区域
    12.           ;lst 很多参数可以放这里面
    13.           ;(get−excel−sheet−v "C:\\Users\\Administrator\\Desktop\\dd.xls" "Sheet1" "A1:B6" nil)   
    14.   (DEFUN $26个字母任意组合$ (nums / a f i is ss sn:leftnthlst)
    15.           ;字母组合
    16.     (defun sn:leftnthlst (i lst / new is cars)
    17.           ;返回一个表中的前n个元素的表,之前的,列表前
    18.           ;示例:(sn:leftnthlst 2 '(1 2 3 4 5 6));返回表(1 2)
    19.           ;如果输入的n值大于表长返回原表;小于1返回nil
    20.       (if
    21.   (and i
    22.        lst
    23.        (= (type i) 'int)
    24.        (= (type lst) 'list)
    25.        (> i 0)
    26.        (<= i (length lst))
    27.        (> (length lst) 0)
    28.   )
    29.    (progn
    30.      (setq is 0)
    31.      (while (< is i)
    32.        (setq cars (car lst))
    33.        (setq new (cons cars new))
    34.        (setq lst (cdr lst))
    35.        (setq is (1+ is))
    36.      )
    37.      (setq new (reverse new))
    38.    )
    39.    (setq new nil)
    40.       )
    41.       new
    42.     )
    43.     (if  (and nums (member (type nums) (list 'int 'real)))
    44.       ()
    45.       (SETQ nums 1000)
    46.     )
    47.     (if  (= (type nums) 'real)
    48.       (setq nums (fix nums))
    49.     )
    50.     (setq i 0)
    51.     (setq iS 0)
    52.     (SETQ F (list "A"  "B"   "C"   "D"    "E"  "F"   "G"   "H"    "I"
    53.       "J"  "K"   "L"   "M"    "N"  "O"   "P"   "Q"    "R"
    54.       "S"  "T"   "U"   "V"    "W"  "X"   "Y"   "Z"
    55.      )
    56.     )
    57.     (SETQ SS (append ss F))
    58.     (if  (< nums 26)
    59.       (setq ss (sn:leftnthlst nums f))
    60.       (while (< (LENGTH SS) nums)
    61.   (SETQ A (NTH I SS))
    62.   (WHILE (AND (< (LENGTH SS) nums) (< IS 26))
    63.     (set 'ss
    64.          (reverse (cons (STRCAT A (NTH IS F)) (reverse ss)))
    65.     )
    66.     (SETQ IS (1+ IS))
    67.   )
    68.   (SETQ I (1+ I))
    69.   (SETQ IS 0)
    70.       )
    71.     )
    72.     ss
    73.   )
    74.   (IF (and excelFile
    75.      (findfile excelFile)
    76.       )
    77.     (PROGN
    78.       (or (and sheetName
    79.          (= (type sheetName) 'str)
    80.     )        ;有值就必须是字串
    81.     (setq sheetName "Sheet1")  ;无值时默认sheet1
    82.       )
    83.       (or (and RangeStr
    84.          (= (type RangeStr) 'str)
    85.          (wcmatch RangeStr "[,[A-Z]*:[A-Z]*,]")
    86.     )        ;要么有值
    87.     (setq RangeStr nil)    ;要么没值,下面程序自动获取可用区域
    88.       )
    89.       (setq xl (vlax-get-or-create-object "Excel.Application"))
    90.           ;创建excel程序对象
    91.       (IF (or (NOT XL) (vl-catch-all-error-p XL))
    92.   (PROGN
    93.     "
    94.           请检查注册表中以下两项的值是否正确
    95. HKEY_CLASSES_ROOT\\Excel.Application\\CLSID
    96. HKEY_CLASSES_ROOT\\CLSID\\{00024500-0000-0000-C000-000000000046}\\LocalServer32
    97.       "
    98.   )
    99.       )
    100.       (AND (NOT (vl-catch-all-error-p XL))
    101.      (setq wbs (vlax-get-property xl "WorkBooks"))
    102.       )
    103.           ;获取excel程序对象的工作簿集合对象  
    104.       (or (and XL
    105.          (NOT (vl-catch-all-error-p XL))
    106.          (setq wb (vlax-get-property XL 'activeworkbook))
    107.           ;工作薄对象
    108.          (NOT (vl-catch-all-error-p wb))
    109.          (setq fullname (vlax-get-property wb 'fullname))
    110.           ;完整路径
    111.          (NOT (vl-catch-all-error-p fullname))
    112.          excelFile
    113.          (= excelFile fullname)  ;等于传入进来的路径
    114.          wb
    115.          (NOT (vl-catch-all-error-p wb))
    116.     )        ;如果这里成立说明文件处于打开状态
    117.     (AND wbs
    118.          (NOT (vl-catch-all-error-p wbs))
    119.          (setq wb  (vl-catch-all-apply
    120.         'vlax-invoke-method
    121.         (list wbs "open" excelFile)
    122.       )
    123.          )
    124.          (setq open? 't)
    125.     )
    126.       )          ;用工作簿集合对象打开指定的excel文件
    127.       (AND wb
    128.      (NOT (vl-catch-all-error-p wb))
    129.      (setq
    130.        shs
    131.         (vl-catch-all-apply 'vlax-get-property (list wb "Sheets"))
    132.      )
    133.       )
    134.           ;获取刚才打开工作簿的所有工作表
    135.       (if (AND shs (NOT (vl-catch-all-error-p shs)))
    136.   (progn (setq sheets-morens
    137.           (cons sheetName
    138.           (list "Sheet1"     "Sheet2"
    139.           "Sheet3"     "Sheet4"
    140.           "Sheet5"     "Sheet6"
    141.           "Sheet7"     "Sheet8"
    142.           "Sheet9"     "Sheet10"
    143.          )
    144.           )
    145.          )
    146.          (SETQ CS 0)
    147.          (while (and (< CS 10)
    148.          (setq sh (vl-catch-all-apply
    149.               'vlax-get-property
    150.               (list shs "Item" sheetName)
    151.             )
    152.          )
    153.          (vl-catch-all-error-p sh)
    154.           )
    155.      (SETQ CS (1+ CS))
    156.      (setq sheetName (car sheets-morens))
    157.      (setq sheets-morens (cdr sheets-morens))
    158.          )
    159.   )
    160.       )          ;获取指定的sheet表
    161.       (if (not RangeStr)
    162.   (or (and sh
    163.      (NOT (vl-catch-all-error-p sh))
    164.      (setq UsedRange (vlax-get-property SH 'UsedRange))
    165.      (setq col (vlax-get-property
    166.            (vlax-get-property UsedRange 'columns)
    167.            'count
    168.          )
    169.      )
    170.      (setq row (vlax-get-property
    171.            (vlax-get-property UsedRange 'rows)
    172.            'count
    173.          )
    174.      )
    175.      (setq col-zms ($26个字母任意组合$ col))
    176.      (setq RangeStr  (strcat  (car col-zms)
    177.           "1:"
    178.           (last col-zms)
    179.           (itoa row)
    180.         )
    181.      )
    182.       )
    183.       (setq RangeStr "A1:Z65535")
    184.   )
    185.       )          ;如果没有传入区域字串就获取可使用区域
    186.       (setq rg (vl-catch-all-apply
    187.      'vlax-get-property
    188.      (list sh "Range" RangeStr)
    189.          )
    190.       )
    191.           ;用指定的字符串创建工作表范围对象
    192.       (AND rg
    193.      (NOT (vl-catch-all-error-p rg))
    194.      (setq
    195.        vvv
    196.         (vl-catch-all-apply 'vlax-get-property (list rg 'Value))
    197.      )
    198.       )
    199.           ;获取范围对象的值
    200.       (AND vvv
    201.      (NOT (vl-catch-all-error-p vvv))
    202.      (setq arr (vl-catch-all-apply
    203.            'vlax-safearray->list
    204.            (list (vlax-variant-value vvv))
    205.          )
    206.      )
    207.       )
    208.           ;转换为数组
    209.       (if open?
    210.   (progn
    211.     (function (lambda () (vlax-invoke-method wb "Close")))
    212.           ;关闭工作簿
    213.     (vl-catch-all-apply
    214.       (function (lambda () (vlax-invoke-method xl "Quit")))
    215.     )        ;退出excel对象
    216.   )
    217.       )
    218.       (vl-catch-all-apply
    219.   (function (lambda () (vlax-release-object sh)))
    220.       )          ;释放sh对象
    221.       (vl-catch-all-apply
    222.   (function (lambda () (vlax-release-object wb)))
    223.       )          ;释放wb对象
    224.       (vl-catch-all-apply
    225.   (function (lambda () (vlax-release-object xl)))
    226.       )          ;释放excel对象
    227.       (IF (AND arr (NOT (vl-catch-all-error-p arr)))
    228.   (SETQ
    229.     DATA
    230.      (mapcar
    231.        (function
    232.          (lambda (a /)
    233.      (mapcar (function
    234.          (lambda (b / str)
    235.            (or (setq str (vlax-variant-value b))
    236.          (setq str "")
    237.            )
    238.            str
    239.          )
    240.        )
    241.        a
    242.      )
    243.          )
    244.        )
    245.        arr
    246.      )
    247.   )
    248.       )
    249.     )
    250.   )
    251.   DATA
    252. )
    复制代码
    回复


    http://www.mjgw.org/ 专业从事膜结构设计、制作加工、施工安装的膜结构工程服务,能够为客户提供专业的膜结构整体解决方案。做中国最好的膜结构综合服务平台。欢迎大家联系电话:198-7840-1958,QQ:463017170.
    相关关键词:膜结构车棚,膜结构车棚覆盖,膜结构车棚公司,膜结构车棚多少钱,膜结构车棚厂家,膜结构车棚价格,社区膜结构车棚,膜结构车棚膜布厂家 ,膜结构车棚哪家好,膜结构车棚多少钱一米,膜结构车棚报价,膜结构车棚哪里有,膜结构车棚定制,膜结构车棚安装,膜结构车棚设计,膜结构车棚电话,膜结构车棚加工,膜结构车棚膜布价格,膜结构车棚批发,膜结构车棚制造商,膜结构车棚生产厂家,膜结构车棚设计,膜结构车棚施工,膜结构车棚多少钱一平米,膜结构车棚订制,张拉膜车棚,张拉膜车棚覆盖,张拉膜车棚公司,张拉膜车棚多少钱,张拉膜车棚厂家,张拉膜车棚价格,社区张拉膜车棚,张拉膜车棚膜布厂家 ,张拉膜车棚哪家好,张拉膜车棚多少钱一米,张拉膜车棚报价,张拉膜车棚哪里有,张拉膜车棚定制,张拉膜车棚安装,张拉膜车棚设计,张拉膜车棚电话,张拉膜车棚加工,张拉膜车棚膜布价格,张拉膜车棚批发,张拉膜车棚制造商,张拉膜车棚生产厂家,张拉膜车棚设计,张拉膜车棚施工,张拉膜车棚多少钱一平米,张拉膜车棚订制,常用膜材品牌:德国杜肯、法国法拉利、德国海德斯、德国米乐、日本平岗、韩国秀博、比利时希运、美国赫虏伯、中国科宝、上海慧遥。

    使用道具 举报

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

    本版积分规则

    关闭

    推荐膜材品牌上一条 /6 下一条

    进口膜材 国产膜材 pvdf膜材ptfe膜材ETFE膜材
    最好的膜结构公司 一级膜结构资质 膜结构一级资质
    膜结构设计-膜结构十大品牌-etfe设计-充气膜结构
    诺科膜结构
    遨都膜结构设计
    中国膜结构网
    中国空间膜结构

    QQ|申请友链|手机版|中国膜结构论坛