不好意思，又有复杂的问题请教了

tjmu

各位老师

不好意思，我又有复杂的问题请教了。word文档包含类似下面的东东：

Axxxxx0 A A A T G A C G T G

Bxxxxx1 G T A T G T C C T C

* * * * *

Axxxxx0 C T A T G A C G G T

Bxxxxx1 G T A T G T C C T C

* * * * *

每个小单元包括3行：第一行为Axxxxx0所在行，第二行为Bxxxxx1所在行，第三行为*（对第一和第二行的解释：如果第一和二行相应的A，T，C，G4种字符相同，那么这个位置就是*，反之则空白）。我现在想把第三行去掉，但*对应的第一和第二行字符同时添加下划线，没有*的地方则不改动。

最后把所有第一行去掉前面的标示（Axxxxx0）并首位相连形成只含A，T，C，G的文档。

最后再在这段文档的最前面添加相应的行标示（Axxxxx0）。

所有第二行也同样处理。最后的结果放同一文档中。

WORD文档中字体颜色不改动。

如果大家有时间，有兴趣帮我看看怎么弄。也不能让首柔斑竹天天都这样帮我啊

希望大家水平高的都帮看看

不急求结果

有时间帮我就可以

多谢

附件是一个例子

vyhFEZbZ.rar (2.46 KB, 下载次数: 12)

2005-3-11 02:49 上传

点击文件名下载附件
不好意思，又有复杂的问题请教了

tjmu

怎么搞的 * 没对齐啊

[em04]

守柔

请楼主仔细检查一下，你上传的附件，是否正确。

问题1：但*对应的第一和第二行字符同时添加下划线，没有*的地方则不改动。也就是说，新生成的段落中，应该有下划线，显然，你的第二个段落中没有下划线（Bxxxxx1）

问题2：既然是新生成的Axxxxx0在前面，为何你的附件结果中，所有Bxxxxx1的两行序列反而直接位于Axxxxx0的下面一个段落中？这有些不合常规逻辑。

要求：请重新上传一份你的结果，是具有代表性的文档，里面的内容应该比较全面和复杂的。

处理：不用VBA编程，肯定是不行的，所以必须编程。而编程讲究的是理解用户的意图，满足或者超越用户的使用要求。因此，必须全面正确理解后，才能编出正确的程序，否则，徒费功夫矣！于事无补，于人无益！

tjmu

非常对不起

上次因为匆忙，上传的文件没处理好。忘记给Bxxxxx1所在的段落标记了。先补上，上传一新的文件。

至于首柔斑竹的第二个问题，我给一个例子：

张三 胖老美哭

李四 胖小美笑

* *

张三 白高良好

李四 白高差坏

**

张三所在行是对张三特征的描述。李四所在行是对李四的描述。但因为一行显示不完所有的特征，所以要分很多行，但是张三和李四每行中每个特征是对应的。所以数据整理后为：

张三

胖老美哭白高良好

李四

胖小美笑白高差坏

呵呵，不知道我说清楚了没有，最近因为这些基因组数据头疼的不行，真后悔以前没有学VBA

不着急，有时间帮我看看，我想这个要是理解清楚了我的意思，应该比上次那个查找问题简单些。

不好意思了。

GxCzTmNU.rar (2.75 KB, 下载次数: 10)

2005-3-12 18:06 上传

点击文件名下载附件
不好意思，又有复杂的问题请教了

守柔

请参：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By 守柔(ShouRou)@ExcelHome 2005-3-13 6:54:29 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Sub SetFormat() Dim i As Paragraph, aChar As Range, MyRange As Range On Error Resume Next Application.ScreenUpdating = False With ActiveDocument For Each i In .Paragraphs '段落中循环 If VBA.InStr(i.Range, " ") = 1 Then '首字包含部分空格 Set MyRange = .Range(i.Range.Start + 16, i.Range.End - 1) '对应于该段落的前一个段落,预置下划线以加快运行速度 .Range(MyRange.Start - 77, MyRange.End - 77).Underline = True '对应于该段落的前两个段落,预置下划线以加快运行速度 .Range(MyRange.Start - 154, MyRange.End - 154).Underline = True For Each aChar In MyRange.Characters If aChar <> "*" Then '如果不是*则去除下划线 .Range(aChar.Start - 77, aChar.End - 77).Underline = False .Range(aChar.Start - 154, aChar.End - 154).Underline = False End If Next End If Next End With Application.ScreenUpdating = True '恢复屏幕更新 Call GetAllGone End Sub '---------------------- Sub GetAllGone() Dim i As Paragraph, MyDoc As Document, MyRange As Range, DocRange As Range On Error Resume Next Application.ScreenUpdating = False Set MyDoc = Documents.Add '新建一个空白文档 Selection.InsertAfter Chr(13) '插入段落标记(此文档中现有两个段落) With ThisDocument '本文档 For Each i In .Paragraphs '本文档段落中循环 If VBA.InStr(i.Range, "Axxxxx0") = 1 Then Set MyRange = .Range(i.Range.Start + 16, i.Range.End - 1) MyRange.Copy '复制相应区域以便保留格式 Set DocRange = MyDoc.Paragraphs(1).Range '在MyDoc的第一个段落标记前一个位置粘贴 MyDoc.Range(DocRange.End - 1, DocRange.End - 1).Paste ElseIf VBA.InStr(i.Range, "Bxxxxx1") = 1 Then Set MyRange = .Range(i.Range.Start + 16, i.Range.End - 1) MyRange.Copy '复制相应区域以便保留格式 Set DocRange = MyDoc.Paragraphs(2).Range '在MyDoc的第一个段落标记前一个位置粘贴 MyDoc.Range(DocRange.End - 1, DocRange.End - 1).Paste End If Next End With With MyDoc '实际应用中,会有空格产生,替换 .Content.Find.Execute findtext:=" ", Replacewith:="", Replace:=wdReplaceAll '插入一个段落 .Paragraphs(1).Range.InsertBefore "Axxxxx0：" & Chr(13) '插入一个段落 .Paragraphs(3).Range.InsertBefore "Bxxxxx1：" & Chr(13) '保存该文档 .SaveAs "New-" & ThisDocument.Name End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

tjmu

神奇！！！

但是有个小问题要请教一下首柔斑竹：第二个宏运行后好象只出现下面的标识，但是没有相应的内容，不知道为什么。

Axxxxx0：

Bxxxxx1：

是不是我没有引用什么呢？

请指教

tjmu

首柔大哥：你帮我写的第一个宏运行后挺好的，该下划线的地方都下划线了。下面那个宏运行后没有内容出来，只是在新文档中出现Axxxxx0：和 Bxxxxx1：这两个标识。其实下划线弄好后我的需求是：将所有的*去掉，然后把标识相同的行从前到后首尾连接起来就可以了（字体颜色不变）分别形成两大部分（Axxxxx0和 Bxxxxx1）就可以了。

多谢你不辞辛苦的帮助！以后回去请你吃饭拉

呵呵

tjmu

运行成功

多谢首柔大哥的辛勤劳动