求大神帮忙解决数据导入excel合并问题
本人菜鸟，想实现a*b-c格式a,b,c分开导入到excel中，其中excel导入是搬运langjs大神的http://bbs.mjtd.com/thread-92023-1-1.html中的代码。字符串分割是搬运自贡黄明儒大神的http://bbs.mjtd.com/forum.php?mod=viewthread&tid=108027中的代码，都不是太明白，但能实现了基本的excel导入（不能识别并排除不正确的格式），请问大神们，能不能实现再加一列数量，将相同的行合并，然后显示数量。(defun c:tt()(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))));选取文字
(progn
(setq lsta '())
(setq lstb '())
(setq lstc '())
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
txt (cdr (assoc 1 ent)));文字值
(setq txta (HH:GetBeforeStr1 txt "*"))
(setq txtc (HH:GetBehindStr1 txt "-"))
(setq txtbc (HH:GetBehindStr1 txt "*"))
(setq txtb (HH:GetBeforeStr1 txtbc "-"))
(setq lsta (cons txta lsta))
(setq lstb (cons txtb lstb))
(setq lstc (cons txtc lstc))
)
(setq lsta (cons "宽度" lsta))
(setq lstb (cons "高度" lstb))
(setq lstc (cons "编号" lstc))
)
)
(initexcel)
(setq numrow 1)
(foreach f lsta
(datacell numrow 1 f)
(setq numrow (1+ numrow))
)
(setq numrow 1)
(foreach f lstb
(datacell numrow 2 f)
(setq numrow (1+ numrow))
)
(setq numrow 1)
(foreach f lstc
(datacell numrow 3 f)
(setq numrow (1+ numrow))
)
(princ)
)
(defun HH:GetBehindstr1 (str st);区分大小写
(car (xd::string:regexps (strcat "[^" st "]+$") str "I"))
)
(defun HH:GetBeforeStr1 (str st);区分大小写
(car (xd::string:regexps (strcat "[^" st "]+") str "I"))
)
(defun XD::String:RegExpS (pat str key / end keys matches x)
(if (not *xxvbsexp)
(setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
)
(vlax-put *xxvbsexp 'Pattern pat)
(if (not key)
(setq key "")
)
(setq key (strcase key))
(setq keys '(("I" "IgnoreCase")
("G" "Global")
("M" "Multiline")
)
)
(mapcar
'(lambda (x)
(if (wcmatch key (strcat "*" (car x) "*"))
(vlax-put *xxvbsexp (read (cadr x)) 0)
(vlax-put *xxvbsexp (read (cadr x)) -1)
)
)
keys
)
(setq matches (vlax-invoke *xxvbsexp 'Execute str))
(vlax-for x matches (setq end (cons (vla-get-value x) end)))
(reverse end)
)
(defun initexcel ()
(setq appxls (vlax-get-or-create-object "excel.application");返回应用程序对象的运行实例。如果应用程序当前未运行，则创建新实例
xlsworkbooks (vlax-get-property appxls "workbooks");
newbook (vlax-invoke-method xlsworkbooks "add")
newsheet (vlax-get-property newbook "sheets")
newitem (vlax-get-property newsheet "item" 1)
xlscells (vlax-get-property newitem "cells")
)
(vla-put-visible appxls :vlax-true)
)
(defun endexcel ()
(vlax-release-object xlscells)
(vlax-release-object newitem)
(vlax-release-object newsheet)
(vlax-release-object newbook)
(vlax-release-object xlsworkbooks)
(vlax-release-object appxls)
)
(defun datacell (nurow col value)
(vlax-put-property xlscells "item" numrow col
(vl-princ-to-string value)
)
)
页:
[1]