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

admin1

[code](defun get−excel−sheet−v (excelFile        sheetName
          RangeStr lst      /         arr
          col       col-zms  cs       DATA
          fullname nm        nms      open?
          rg       row      sh       sheets-morens
          shs       ttt      usedrange
          vvv       wb        wbs      xl
         )
          ;excelFile xls文件路径
          ;sheetName 表名字
          ;RangeStr 数据区域
          ;lst 很多参数可以放这里面
          ;(get−excel−sheet−v "C:\\Users\\Administrator\\Desktop\\dd.xls" "Sheet1" "A1:B6" nil)   
  (DEFUN $26个字母任意组合$ (nums / a f i is ss sn:leftnthlst)
          ;字母组合
    (defun sn:leftnthlst (i lst / new is cars)
          ;返回一个表中的前n个元素的表,之前的,列表前
          ;示例：(sn:leftnthlst 2 '(1 2 3 4 5 6))；返回表(1 2)
          ;如果输入的n值大于表长返回原表；小于1返回nil
      (if
  (and i
       lst
       (= (type i) 'int)
       (= (type lst) 'list)
       (> i 0)
       (<= i (length lst))
       (> (length lst) 0)
  )
   (progn
     (setq is 0)
     (while (< is i)
       (setq cars (car lst))
       (setq new (cons cars new))
       (setq lst (cdr lst))
       (setq is (1+ is))
     )
     (setq new (reverse new))
   )
   (setq new nil)
      )
      new
    )
    (if  (and nums (member (type nums) (list 'int 'real)))
      ()
      (SETQ nums 1000)
    )
    (if  (= (type nums) 'real)
      (setq nums (fix nums))
    )
    (setq i 0)
    (setq iS 0)
    (SETQ F (list "A"  "B"   "C"   "D"    "E"  "F"   "G"   "H"    "I"
      "J"  "K"   "L"   "M"    "N"  "O"   "P"   "Q"    "R"
      "S"  "T"   "U"   "V"    "W"  "X"   "Y"   "Z"
     )
    )
    (SETQ SS (append ss F))
    (if  (< nums 26)
      (setq ss (sn:leftnthlst nums f))
      (while (< (LENGTH SS) nums)
  (SETQ A (NTH I SS))
  (WHILE (AND (< (LENGTH SS) nums) (< IS 26))
    (set 'ss
         (reverse (cons (STRCAT A (NTH IS F)) (reverse ss)))
    )
    (SETQ IS (1+ IS))
  )
  (SETQ I (1+ I))
  (SETQ IS 0)
      )
    )
    ss
  )
  (IF (and excelFile
     (findfile excelFile)
      )
    (PROGN
      (or (and sheetName
         (= (type sheetName) 'str)
    )        ;有值就必须是字串
    (setq sheetName "Sheet1")  ;无值时默认sheet1
      )
      (or (and RangeStr
         (= (type RangeStr) 'str)
         (wcmatch RangeStr "[,[A-Z]*:[A-Z]*,]")
    )        ;要么有值
    (setq RangeStr nil)    ;要么没值，下面程序自动获取可用区域
      )
      (setq xl (vlax-get-or-create-object "Excel.Application"))
          ;创建excel程序对象
      (IF (or (NOT XL) (vl-catch-all-error-p XL))
  (PROGN
    "
          请检查注册表中以下两项的值是否正确
HKEY_CLASSES_ROOT\\Excel.Application\\CLSID
HKEY_CLASSES_ROOT\\CLSID\\{00024500-0000-0000-C000-000000000046}\\LocalServer32
      "
  )
      )
      (AND (NOT (vl-catch-all-error-p XL))
     (setq wbs (vlax-get-property xl "WorkBooks"))
      )
          ;获取excel程序对象的工作簿集合对象  
      (or (and XL
         (NOT (vl-catch-all-error-p XL))
         (setq wb (vlax-get-property XL 'activeworkbook))
          ;工作薄对象
         (NOT (vl-catch-all-error-p wb))
         (setq fullname (vlax-get-property wb 'fullname))
          ;完整路径
         (NOT (vl-catch-all-error-p fullname))
         excelFile
         (= excelFile fullname)  ;等于传入进来的路径
         wb
         (NOT (vl-catch-all-error-p wb))
    )        ;如果这里成立说明文件处于打开状态
    (AND wbs
         (NOT (vl-catch-all-error-p wbs))
         (setq wb  (vl-catch-all-apply
        'vlax-invoke-method
        (list wbs "open" excelFile)
      )
         )
         (setq open? 't)
    )
      )          ;用工作簿集合对象打开指定的excel文件
      (AND wb
     (NOT (vl-catch-all-error-p wb))
     (setq
       shs
        (vl-catch-all-apply 'vlax-get-property (list wb "Sheets"))
     )
      )
          ;获取刚才打开工作簿的所有工作表
      (if (AND shs (NOT (vl-catch-all-error-p shs)))
  (progn (setq sheets-morens
          (cons sheetName
          (list "Sheet1"     "Sheet2"
          "Sheet3"     "Sheet4"
          "Sheet5"     "Sheet6"
          "Sheet7"     "Sheet8"
          "Sheet9"     "Sheet10"
         )
          )
         )
         (SETQ CS 0)
         (while (and (< CS 10)
         (setq sh (vl-catch-all-apply
              'vlax-get-property
              (list shs "Item" sheetName)
            )
         )
         (vl-catch-all-error-p sh)
          )
     (SETQ CS (1+ CS))
     (setq sheetName (car sheets-morens))
     (setq sheets-morens (cdr sheets-morens))
         )
  )
      )          ;获取指定的sheet表
      (if (not RangeStr)
  (or (and sh
     (NOT (vl-catch-all-error-p sh))
     (setq UsedRange (vlax-get-property SH 'UsedRange))
     (setq col (vlax-get-property
           (vlax-get-property UsedRange 'columns)
           'count
         )
     )
     (setq row (vlax-get-property
           (vlax-get-property UsedRange 'rows)
           'count
         )
     )
     (setq col-zms ($26个字母任意组合$ col))
     (setq RangeStr  (strcat  (car col-zms)
          "1:"
          (last col-zms)
          (itoa row)
        )
     )
      )
      (setq RangeStr "A1:Z65535")
  )
      )          ;如果没有传入区域字串就获取可使用区域
      (setq rg (vl-catch-all-apply
     'vlax-get-property
     (list sh "Range" RangeStr)
         )
      )
          ;用指定的字符串创建工作表范围对象
      (AND rg
     (NOT (vl-catch-all-error-p rg))
     (setq
       vvv
        (vl-catch-all-apply 'vlax-get-property (list rg 'Value))
     )
      )
          ;获取范围对象的值
      (AND vvv
     (NOT (vl-catch-all-error-p vvv))
     (setq arr (vl-catch-all-apply
           'vlax-safearray->list
           (list (vlax-variant-value vvv))
         )
     )
      )
          ;转换为数组
      (if open?
  (progn
    (function (lambda () (vlax-invoke-method wb "Close")))
          ;关闭工作簿
    (vl-catch-all-apply
      (function (lambda () (vlax-invoke-method xl "Quit")))
    )        ;退出excel对象
  )
      )
      (vl-catch-all-apply
  (function (lambda () (vlax-release-object sh)))
      )          ;释放sh对象
      (vl-catch-all-apply
  (function (lambda () (vlax-release-object wb)))
      )          ;释放wb对象
      (vl-catch-all-apply
  (function (lambda () (vlax-release-object xl)))
      )          ;释放excel对象
      (IF (AND arr (NOT (vl-catch-all-error-p arr)))
  (SETQ
    DATA
     (mapcar
       (function
         (lambda (a /)
     (mapcar (function
         (lambda (b / str)
           (or (setq str (vlax-variant-value b))
         (setq str "")
           )
           str
         )
       )
       a
     )
         )
       )
       arr
     )
  )
      )
    )
  )
  DATA
)[/code]