邮件合并与循环/分组合并

Question

我有一张Excel表，我用来将其合并到Word中。

邮件合并是通过此代码完成的

'starting the mail merge for the main body of the report
Set wdDoc = wdApp.Documents.Open(fNameW)
wdDoc.Activate
wdDoc.MailMerge.OpenDataSource Name:=(fNameE), Revert:=False, Connection:="Entire Spreadsheet", SQLStatement:="SELECT * FROM `'Table of Recommendations$'`", SQLStatement1:=""
With wdDoc.MailMerge
    .MainDocumentType = wdFormLetters
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute
    
    For Each wd In ActiveDocument.StoryRanges
    With wd.Find
        .Text = "(blank)"
        .Replacement.Text = ""
        .Forward = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
    
    With wd.Find
        .Text = "^b"
        .Wrap = wdFindContinue
        While .Execute
            wd.Delete
            wd.InsertParagraph
        Wend
    End With
    Next wd

，这是我获得的输出：

现在，我的问题。我想实现的是，推荐编号（b）被插入了第一张表格，仅在推荐编号（a）的基础上，这两个建议来自同一问题 country Comporation 。换句话说，合并过程应循环通过Excel表，如果问题相同，则应将建议组合在一起，省略空白单元格，而不是生成第二个表。您认为这是可能的吗？如果是，您能指出我的方向正确吗？我已经搜索了互联网，但找不到任何解决方案。谢谢。

Answer 1

我确实建议您更改数据！包括您现在在两个单元中具有的“推荐文本”值，现在将其纳入一个多行细胞：

(a) Expedite an evaluation ... [AltGr][Enter]
(b) Develop, publish and disseminate

Answer 2

1. 将串联列添加到数据库数据的副本
   = if（$ c13 =“”，e12＆amp; char（10）＆amp; d13，e12）...对于下面的第12行

   中的第12行

2. 过滤您的非空行的数据（例如col“ colding croppppent”）< /p>

。
。
带有“串联列”的屏幕截图

。
。
屏幕截图过滤数据

Answer 3

根据@macropod给出的建议，我解决了问题。 Using the guideline available at https:/ /www.msofficeforums.com/mail-merge/38721-microsoft-word-catalogue-directory-mailmerge-tutorial.html ，我能够解决问题。我按照《 AFIRE指南》第4页的第4页设置了邮件合并模板，并添加了“木匠”宏观宏观，以前指南的第20/21页中描述并解决了我的问题。下面我写的代码示例：

'starting the mail merge for the main body of the report
With wdApp 'launching Ms Word
fNameW = "C:\Users\" & uName & "\OneDrive...\Main Body.dotx"
.Visible = True
.Documents.Open fNameW, , ReadOnly

Set wdDoc = wdApp.Documents.Open(fNameW)
wdDoc.Activate
wdDoc.MailMerge.OpenDataSource Name:=(fNameE), Revert:=False, Connection:="Entire Spreadsheet", SQLStatement:="SELECT * FROM `'Table of Recommendations
`", SQLStatement1:=""
With wdDoc.MailMerge
    .MainDocumentType = wdCatalog
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute
    
    For Each wd In ActiveDocument.StoryRanges
    With wd.Find
        .Text = "(blank)"
        .Replacement.Text = ""
        .Forward = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
    Next wd
    
    For Each oPara In ActiveDocument.Paragraphs
        With oPara.Range
            If .Information(wdWithInTable) = True Then
                 With .Next
                    If .Information(wdWithInTable) = False Then
                        If .Text = vbCr Then .Delete
                    End If
                End With
            End If
        End With
    Next
    
    ChangeFileOpenDirectory fod
    ActiveDocument.SaveAs2 Filename:=fnameMB, FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ActiveDocument.Close

End With

Sheets("Table of Recommendations").Select
Range(rangeTC).Select
Selection.Clear

wdDoc.Close savechanges:=wdDoNotSaveChanges