Question

我有以下表格：

列A | B栏| C栏

X BOB APPLE

X BOB BANANA

X BOB PEAR

Y SARAH APPLE

是的，SARAH KIWI

Z CARL BANANA

Z CARL PINEAPPLE

Z CARL WATERMELON

Z CARL KIWI

我希望能够循环遍历A列，为每个唯一的列A值生成一个word文档，其中B列中的值为文档名称，C列为内容。在上表中，标题为'Bob'的文档将包含'Apple Banana Pear'，另一个标题为'Sarah'的文档将包含'Apple Kiwi'，第三个标题为'Carl'的文档将包含'Banana Pineapple Watermelon Kiwi'。< / p>

我找到了代码，我根据自己的情况进行了调整，将Excel中的所有内容复制并粘贴到word文档中，但这就是我被困住的地方。不同的excel文档有不同的行数，一次是A列中的X，Y，Z，另一次是V，W，X，Y，Z.我知道我需要从x = 1循环到Len（单元格（x，1））= 0，但应用此我不知道如何。希望能在这里输入我的小问题，并有兴趣了解并理解你的理由。一如既往地谢谢。代码：

Option Explicit


Sub DataToWord()


Dim rng As Range 
Dim wdApp As Object 
Dim wdDoc As Object 
Dim t As Word.Range 
Dim myWordFile As String 
Dim x As Long

'initialize the Word template path
'here, it's set to be in the same directory as our source workbook
myWordFile = ThisWorkbook.Path & "\Document.dotx"

'get the range of the contiguous data from Cell A1
Set rng = Range("A1").CurrentRegion
'you can do some pre-formatting with the range here
rng.HorizontalAlignment = xlCenter 'center align the data
rng.Copy 'copy the range

Set wdApp = CreateObject("Word.Application")
'open a new word document from the template
Set wdDoc = wdApp.Documents.Add(myWordFile)

Set t = wdDoc.Content 'set the range in Word
t.Paste 'paste in the table
With t 'working with the table range
'we can use the range object to do some more formatting
'here, I'm matching the table with using the Excel range's properties
.Tables(1).Columns.SetWidth (rng.Width / rng.Columns.Count), wdAdjustSameWidth
End With

'until now the Word app has been a background process
wdApp.Visible = True
'we could use the Word app object to finish off
'you may also want to things like generate a filename and save the file
wdApp.Activate


End Sub

Answer 1

我相信这应该做你想做的事情：

Option Explicit


Sub DataToWord()

    Dim rng As Range
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim t As Word.Range
    Dim myWordFile As String
    Dim x As Long

    'initialize the Word template path
    'here, it's set to be in the same directory as our source workbook
    myWordFile = ThisWorkbook.Path & "\Document.dotx"

    'Define the exclusive values of column A
    Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Copy
    Range("E1").PasteSpecial
    Range(Range("E1"), Range("E" & Rows.Count).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo


    Set wdApp = CreateObject("Word.Application")

    'Inserts row necessary for autofilter, since the table has no headers
    Rows(1).Insert

    Dim excValue As Range
    For Each excValue In Range(Range("E2"), Range("E" & Rows.Count).End(xlUp))

        'Copies the data for that specific value
        Range(Range("A1"), Range("C" & Rows.Count).End(xlUp)).AutoFilter Field:=1, Criteria1:=excValue
        Range(Range("C2"), Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy

        'open a new word document from the template
        Set wdDoc = wdApp.Documents.Add(myWordFile)

        Set t = wdDoc.Content 'set the range in Word
        t.Paste 'paste in the table
        With t 'working with the table range
        'we can use the range object to do some more formatting
        'here, I'm matching the table with using the Excel range's properties
        .Tables(1).Columns.SetWidth (Range("C1").Width), wdAdjustSameWidth
        End With

        Dim name As String
        name = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)(1).Value
        wdDoc.SaveAs Filename:=ThisWorkbook.Path & "\" & name & ".docx"

    Next excValue

    'Deletes the inserted row
    Rows(1).Delete
    'Clear the column E
    Columns("E").Clear

    'until now the Word app has been a background process
    wdApp.Visible = True
    'we could use the Word app object to finish off
    'you may also want to things like generate a filename and save the file
    wdApp.Activate


End Sub

确保E列中没有任何内容，因为它在执行期间将独占值放在那里。希望它有所帮助。

每个独特单元格的一个word文档

1 个答案: