각 고유 한 셀에 대한 한 단어의 문서

Question

다음과 같은 Excel 테이블이 있습니다.

컬럼 A | 열 B | 열 C

X BOB APPLE

X BOB BANANA

X BOB PEAR

Y SARAH APPLE

Y SARAH KIWI

Z CARL BANANA

Z CARL PINEAPPLE

Z 칼 수박

Z 칼 KIWI

내가, 각각의 고유 한 컬럼 값에 대해, A 열을 순환 할 수 이름으로 열 B의 값으로 워드 문서를 생성하고 싶은

와 C 럼을 내용으로합니다. 위의 표에서 'Bob'이라는 제목의 문서에는 'Apple Banana Pear', 'Sarah'에는 'Apple Kiwi'라는 제목의 문서, 'Carl'이라는 제목의 세 번째 문서에는 'Banana Pineapple Watermelon Kiwi'가 포함됩니다.

필자는 필자의 상황에 맞춰 코드를 찾았는데,이 코드는 내 Excel의 모든 내용을 Word 문서에 복사하여 붙여 넣을 수 있지만, 여기서는 내가 붙어있는 곳입니다. 엑셀 문서마다 행 수가 다르며 한 번 열 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에 아무것도 확인하십시오. 희망이 도움이됩니다.