求大神帮忙解决数据导入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导入（不能识别并排除不正确的格式），请问大神们，能不能实现再加一列数量，将相同的行合并，然后显示数量。

2. (defun c:tt()
   
3.   (vl-load-com)
   
4.   (if (setq ss (ssget '((0 . "*TEXT"))));选取文字
   
5.     (progn
   
6.   (setq lsta '())
   
7.   (setq lstb '())
   
8.   (setq lstc '())
   
9.       (repeat (setq i (sslength ss))
   
10.        (setq ent (entget (ssname ss (setq i (1- i))))
    
11.            txt (cdr (assoc 1 ent)));文字值
    
12.        (setq txta (HH:GetBeforeStr1 txt "*"))
    
13.        (setq txtc (HH:GetBehindStr1 txt "-"))
    
14.        (setq txtbc (HH:GetBehindStr1 txt "*"))
    
15.        (setq txtb (HH:GetBeforeStr1 txtbc "-"))
    
16.        (setq lsta (cons txta lsta))
    
17.        (setq lstb (cons txtb lstb))
    
18.        (setq lstc (cons txtc lstc))
    
19.     )
    
20.       (setq lsta (cons "宽度" lsta))
    
21.     (setq lstb (cons "高度" lstb))
    
22.     (setq lstc (cons "编号" lstc))
    
23.      )
    
24.    )
    
25.    (initexcel)
    
26.    (setq numrow 1)
    
27.    (foreach f lsta
    
28. (datacell numrow 1 f)
    
29. (setq numrow (1+ numrow))
    
30.       )
    
31.     (setq numrow 1)
    
32.     (foreach f lstb
    
33. (datacell numrow 2 f)
    
34. (setq numrow (1+ numrow))
    
35.       )
    
36.     (setq numrow 1)
    
37.     (foreach f lstc
    
38. (datacell numrow 3 f)
    
39. (setq numrow (1+ numrow))
    
40.       )
    
41.   (princ)
    
42. )
    
43. 
    
44. (defun HH:GetBehindstr1 (str st);区分大小写
    
45.   (car (xd::string:regexps (strcat "[^" st "]+$") str "I"))
    
46. )
    
47. (defun HH:GetBeforeStr1 (str st);区分大小写
    
48.   (car (xd::string:regexps (strcat "[^" st "]+") str "I"))
    
49. )
    
50. (defun XD::String:RegExpS (pat str key / end keys matches x)
    
51.   (if (not *xxvbsexp)
    
52.     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))
    
53.   )
    
54.   (vlax-put *xxvbsexp 'Pattern pat)
    
55.   (if (not key)
    
56.     (setq key "")
    
57.   )
    
58.   (setq key (strcase key))
    
59.   (setq        keys '(("I" "IgnoreCase")
    
60.                ("G" "Global")
    
61.                ("M" "Multiline")
    
62.               )
    
63.   )
    
64.   (mapcar
    
65.     '(lambda (x)
    
66.        (if (wcmatch key (strcat "*" (car x) "*"))
    
67.          (vlax-put *xxvbsexp (read (cadr x)) 0)
    
68.          (vlax-put *xxvbsexp (read (cadr x)) -1)
    
69.        )
    
70.      )
    
71.     keys
    
72.   )
    
73.   (setq matches (vlax-invoke *xxvbsexp 'Execute str))
    
74.   (vlax-for x matches (setq end (cons (vla-get-value x) end)))
    
75.   (reverse end)
    
76. )
    
77. 
    
78. (defun initexcel ()
    
79.     (setq appxls (vlax-get-or-create-object "excel.application");返回应用程序对象的运行实例。如果应用程序当前未运行，则创建新实例
    
80.    xlsworkbooks (vlax-get-property appxls "workbooks");
    
81.    newbook (vlax-invoke-method xlsworkbooks "add")
    
82.    newsheet (vlax-get-property newbook "sheets")
    
83.    newitem (vlax-get-property newsheet "item" 1)
    
84.    xlscells (vlax-get-property newitem "cells")
    
85.     )
    
86.     (vla-put-visible appxls :vlax-true)
    
87.   )
    
88. (defun endexcel ()
    
89.     (vlax-release-object xlscells)
    
90.     (vlax-release-object newitem)
    
91.     (vlax-release-object newsheet)
    
92.     (vlax-release-object newbook)
    
93.     (vlax-release-object xlsworkbooks)
    
94.     (vlax-release-object appxls)
    
95.   )
    
96. (defun datacell (nurow col value)
    
97.     (vlax-put-property xlscells "item" numrow col
    
98.          (vl-princ-to-string value)
    
99.     )
    
100.   )

(defun c:tt()<br />   (vl-load-com)<br />   (if (setq ss (ssget '((0 . "*TEXT"))));选取文字<br />     (progn<br />   (setq lsta '())<br />   (setq lstb '())<br />   (setq lstc '())<br />       (repeat (setq i (sslength ss))<br />        (setq ent (entget (ssname ss (setq i (1- i))))<br />            txt (cdr (assoc 1 ent)));文字值<br />        (setq txta (HH:GetBeforeStr1 txt "*"))<br />        (setq txtc (HH:GetBehindStr1 txt "-"))<br />        (setq txtbc (HH:GetBehindStr1 txt "*"))<br />        (setq txtb (HH:GetBeforeStr1 txtbc "-"))<br />        (setq lsta (cons txta lsta))<br />        (setq lstb (cons txtb lstb))<br />        (setq lstc (cons txtc lstc))<br />     )<br />       (setq lsta (cons "宽度" lsta))<br />     (setq lstb (cons "高度" lstb))<br />     (setq lstc (cons "编号" lstc))<br />      )<br />    )<br />    (initexcel)<br />    (setq numrow 1)<br />    (foreach f lsta<br /> (datacell numrow 1 f)<br /> (setq numrow (1+ numrow))<br />       )<br />     (setq numrow 1)<br />     (foreach f lstb<br /> (datacell numrow 2 f)<br /> (setq numrow (1+ numrow))<br />       )<br />     (setq numrow 1)<br />     (foreach f lstc<br /> (datacell numrow 3 f)<br /> (setq numrow (1+ numrow))<br />       )<br />   (princ)<br /> )<br /> <br /> (defun HH:GetBehindstr1 (str st);区分大小写<br />   (car (xd::string:regexps (strcat "[^" st "]+$") str "I"))<br /> )<br /> (defun HH:GetBeforeStr1 (str st);区分大小写<br />   (car (xd::string:regexps (strcat "[^" st "]+") str "I"))<br /> )<br /> (defun XD::String:RegExpS (pat str key / end keys matches x)<br />   (if (not *xxvbsexp)<br />     (setq *xxvbsexp (vlax-get-or-create-object "VBScript.RegExp"))<br />   )<br />   (vlax-put *xxvbsexp 'Pattern pat)<br />   (if (not key)<br />     (setq key "")<br />   )<br />   (setq key (strcase key))<br />   (setq        keys '(("I" "IgnoreCase")<br />                ("G" "Global")<br />                ("M" "Multiline")<br />               )<br />   )<br />   (mapcar<br />     '(lambda (x)<br />        (if (wcmatch key (strcat "*" (car x) "*"))<br />          (vlax-put *xxvbsexp (read (cadr x)) 0)<br />          (vlax-put *xxvbsexp (read (cadr x)) -1)<br />        )<br />      )<br />     keys<br />   )<br />   (setq matches (vlax-invoke *xxvbsexp 'Execute str))<br />   (vlax-for x matches (setq end (cons (vla-get-value x) end)))<br />   (reverse end)<br /> )<br /> <br /> (defun initexcel ()<br />     (setq appxls (vlax-get-or-create-object "excel.application");返回应用程序对象的运行实例。如果应用程序当前未运行，则创建新实例<br />    xlsworkbooks (vlax-get-property appxls "workbooks");<br />    newbook (vlax-invoke-method xlsworkbooks "add")<br />    newsheet (vlax-get-property newbook "sheets")<br />    newitem (vlax-get-property newsheet "item" 1)<br />    xlscells (vlax-get-property newitem "cells")<br />     )<br />     (vla-put-visible appxls :vlax-true)<br />   )<br /> (defun endexcel ()<br />     (vlax-release-object xlscells)<br />     (vlax-release-object newitem)<br />     (vlax-release-object newsheet)<br />     (vlax-release-object newbook)<br />     (vlax-release-object xlsworkbooks)<br />     (vlax-release-object appxls)<br />   )<br /> (defun datacell (nurow col value)<br />     (vlax-put-property xlscells "item" numrow col<br />          (vl-princ-to-string value)<br />     )<br />   )