tsml 发表于 2009-7-29 01:24:00

查找到文字并在其后加excel单元格内的文字？

本帖最后由 作者 于 2009-8-6 0:47:21 编辑 <br /><br /> <p>有下面一个程序，我怎么编也编不好，哪位老兄能帮我编一下，最好用VBA，拜谢了！！！</p><p>设有一个excel表name.xls如下，上行为姓名，下行为年龄，</p><p>&nbsp;&nbsp;&nbsp;&nbsp; A&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; B&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</p><p>1&nbsp;&nbsp;&nbsp;&nbsp;张三&nbsp;&nbsp; 30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</p><p>2&nbsp;&nbsp;&nbsp;&nbsp;李四&nbsp;&nbsp;&nbsp;32</p><p>3&nbsp;&nbsp;&nbsp; 王五&nbsp;&nbsp;&nbsp;34&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </p><p>4&nbsp;&nbsp;&nbsp; 赵六&nbsp;&nbsp; 28</p><p></p><p>用鼠标在CAD中框中一些文字后，执行程序，就可以与excel表中的相比较，当文字中包含“王五”，该文字就变为“王五” &nbsp;“34”(注意是在后面加一个字符串“34”，一共两个字符串) ，再接着找下一个被选中的文字重选与该表比较，找完为止。</p><p>以下是程序，编译通不过</p><p>---------------------------------------------------------------------</p><p>'比较CAD中选中的文字，如果与excel中指定列中某一单元格的文字相同，则在CAD中的该文字后加入excel该单元格同行不同列的另一单元格的文字<br/>Sub getdata()<br/>Dim sel As AcadSelectionSet<br/>Dim i As Integer<br/>Dim j As Integer<br/>Dim start1 As Variant<br/>Dim textObj As AcadText<br/>Dim rows As Integer<br/>Dim cols As Integer<br/>Dim textString As String<br/>Dim Height As Double</p><p>Height = 250<br/>On Error Resume Next</p><p>'选择对象<br/>Set sel = ThisDrawing.SelectionSets.Add("ssel")</p><p>If Err Then<br/>&nbsp;&nbsp;&nbsp; Err.Clear<br/>&nbsp;&nbsp;&nbsp; Set sel = ThisDrawing.SelectionSets.Item("ssel")<br/>End If</p><p>On Error GoTo 0<br/>sel.SelectOnScreen<br/>Dim Ent As AcadEntity</p><p>Dim xlApp As Excel.Application<br/>Set xlApp = GetObject(, "Excel.Application")</p><p>If Err Then<br/>&nbsp;&nbsp;&nbsp; MsgBox " Excel 应用程序没有运行。请启动 Excel 并重新运行程序。"<br/>&nbsp;&nbsp;&nbsp; Exit Sub<br/>End If</p><p>Dim xlSheet As Worksheet<br/>Set xlSheet = xlApp.ActiveSheet</p><p>Dim xlRange As Range<br/>Debug.Print xlSheet.UsedRange.Address</p><p>'比较所有选中的文字<br/>For Each Ent In sel<br/>&nbsp;&nbsp;&nbsp; If LCase(Ent.ObjectName) = "acdbtext" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set textObj = Ent<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>'比较到相同的文字则保存下来<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 1 To UsedRange.rows.Count<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If UsedRange.Offset(i, 1).Range("A1").Value = textObj.textString Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j = j + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textString = textObj.textString = UsedRange.Offset(i, 2).Range("A1").Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; i = i + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If j &lt;&gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Height = textObj.Height<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; start1 = textObj.InsertionPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; start1(0) = start1(0) + 10<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set textObj = ThisDrawing.ModelSpace.AddText(textString, start1, Height)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If j = 1 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj.color = acBlue&nbsp;&nbsp; 'excel中文字只出现过一次，则文字为蓝色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj.color = acRed&nbsp;&nbsp; 'excel中有复的文字，则文字改为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; newtextObj.Update<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; <br/>Next</p><p>Set xlRange = Nothing<br/>Set xlSheet = Nothing<br/>Set xlApp = Nothing<br/>sel.Delete</p><p>End Sub</p><p>&nbsp;</p><p><br/>&nbsp;</p>

雪山飞狐_lzh 发表于 2009-7-29 15:37:00

<p>你的代码？</p>

tsml 发表于 2009-8-6 00:48:00

代码加上去了，谢谢！

mccad 发表于 2009-8-6 06:38:00

简单一点是，先把Excel表中的数据读出，变成一个二维数组。在ACAD中选择文本后，直接与二维数组比较。
页: [1]
查看完整版本: 查找到文字并在其后加excel单元格内的文字？