[求助]如何用VBA合并满足特定条件的两个相邻的段落？

cat2123

昨天我发了一个帖子“[求助]如何删除包含组合条件段落的段落标记？”，我的要求是删除特定段落的段落换行符号（这些段落必须是字符数少于150个且段落里包含“Bibliographic Information-”），使这个特定段和下一段落能合并成一个段落。

比方说：

Bibliographic Information- 
Model studies on the crosslinking of epoxy resins with amines at room temperature.
Gross, A.; Brockmann, H.; Kollek, H. Dep. Chem., Univ. Bielefeld, Bielefeld, Fed.  

（上面是3个段落）

斑竹给了我一个答案：

Sub Rep()

    Dim myString As String, myArray() As String, aArray As Variant
    Dim myText As String
    With ActiveDocument
        myString = .Content.Text
        myArray = VBA.Split(myString, Chr(13))
        For Each aArray In myArray
            If Len(aArray) <= 200 And InStr(aArray, "Bibliographic Information-") > 0 Then
            myText = myText & aArray
            Next
        .Content.Text = myText
            Else
            myText = myText & aArray & Chr(13)
            End If
        Next
        .Content.Text = myText
    End With

我调试了一下，发了一个问题，就是程序运行完成后，大部分文档都合乎要求，只有少部分有点问题。问题是：程序运行完毕后，还有少数行没有被删除段落标记，

例如上面的例子，运行完毕后如下：

Bibliographic Information-Model studies on the crosslinking of epoxy resins with amines at room temperature.
Gross, A.; Brockmann, H.; Kollek, H. Dep. Chem., Univ. Bielefeld, Bielefeld, Fed.

（上面是2个段落）

Bibliographic Information-Model studies on the crosslinking of epoxy resins with amines at room temperature.    这段仍然是满足字符数少于150个且段落里包含“Bibliographic Information-”，当然我知道这是程序运行后才产生的。

因此呢，我呢，就参照斑竹的代码，在上段程序后面加入了同样的代码，合起来是：

Sub Rep()

    Dim myString As String, myArray() As String, aArray As Variant
    Dim myText As String
    With ActiveDocument
        myString = .Content.Text
        myArray = VBA.Split(myString, Chr(13))
        For Each aArray In myArray
            If Len(aArray) <= 200 And InStr(aArray, "Bibliographic Information-") > 0 Then
            myText = myText & aArray
            Next
        .Content.Text = myText
            Else
            myText = myText & aArray & Chr(13)
            End If
        Next
        .Content.Text = myText
    End With

    With ActiveDocument
        myString = .Content.Text
        myArray = VBA.Split(myString, Chr(13))
        For Each aArray In myArray
            If Len(aArray) <= 200 And InStr(aArray, "Bibliographic Information-") > 0 Then
            myText = myText & aArray
            Next
        .Content.Text = myText
            Else
            myText = myText & aArray & Chr(13)
            End If
        Next
        .Content.Text = myText
    End With
end sub

发现所有记录里已经都没有满足字符数少于150个且段落里包含“Bibliographic Information-”，满足了我的要求，可是发现，文档的内容整体重复了两边：

Bibliographic Information-Model studies on the crosslinking of epoxy resins with amines at room temperature.Gross, A.; Brockmann, H.; Kollek, H. Dep. Chem., Univ. Bielefeld, Bielefeld, Fed.
Bibliographic Information-Model studies on the crosslinking of epoxy resins with amines at room temperature.Gross, A.; Brockmann, H.; Kollek, H. Dep. Chem., Univ. Bielefeld, Bielefeld, Fed.

(上面其实是两段，只是网页行的字数有限，呈现出来像是4段)

恳请高手赐教！！！

G42eDIXA.txt (2.34 KB, 下载次数: 10)

2006-9-25 09:44 上传

点击文件名下载附件
[求助]如何用VBA合并满足特定条件的两个相邻的段落？

[此贴子已经被作者于2006-9-25 9:45:43编辑过]

cat2123

快帮帮我呀！！！

konggs

不对吧？一个For对二个next?

cat2123

代码贴错了，那部分如下：

Sub Rep()

    Dim myString As String, myArray() As String, aArray As Variant
    Dim myText As String
    With ActiveDocument
        myString = .Content.Text
        myArray = VBA.Split(myString, Chr(13))
        For Each aArray In myArray
            If Len(aArray) <= 200 And InStr(aArray, "Bibliographic Information-") > 0 Then
            myText = myText & aArray
        .Content.Text = myText
            Else
            myText = myText & aArray & Chr(13)
            End If
        Next
        .Content.Text = myText
    End With

    With ActiveDocument
        myString = .Content.Text
        myArray = VBA.Split(myString, Chr(13))
        For Each aArray In myArray
            If Len(aArray) <= 200 And InStr(aArray, "Bibliographic Information-") > 0 Then
            myText = myText & aArray
        .Content.Text = myText
            Else
            myText = myText & aArray & Chr(13)
            End If
        Next
        .Content.Text = myText
    End With
end sub

cat2123

去掉那两个多余的next

cat2123

恳请高手赐教！！！