Excel VBA 배열을 사용하여 더 많은 통합 문서를 여는 방법은 무엇입니까?

Question

나는 4 개의 파일을 병합해야하는 직업이있다. 미래에 병합 할 파일이 더 많은지, 대신 "통합 문서"코드를 입력했는지 알 수 있습니까? 어떤 방법을 사용해야합니까? 가장 낮은 라인 병합 기준을 충족시킵니다. 아래 코드는 쉬운 방법으로 더 통합 문서를 열어 루프를 찾고 ... 내가 지금까지

Sub GetFile() 
Dim Book1Path As Variant, Book2Path As Variant, Book3Path As Variant, Book4Path As Variant 
Dim SourceWB As Workbook, DestWB As Workbook 
Dim lRow As Long 

Dim ws1, ws2, ws3, ws4 As Worksheet 
Dim c3ll1, c3ll2, c3113, c3114, range1, range2, range3, range4 As Range 

'## Open both workbook first: 

Book1Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 1") 
If Book1Path = False Then Exit Sub 
Set SourceWB = Workbooks.Open(Book1Path) 

Book2Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 2") 
If Book2Path = False Then Exit Sub 
Set DestWB = Workbooks.Open(Book2Path) 

Book3Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 3") 
If Book3Path = False Then Exit Sub 
Set DestWB = Workbooks.Open(Book3Path) 

Book4Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter 4") 
If Book4Path = False Then Exit Sub 
Set DestWB = Workbooks.Open(Book4Path) 

'Copy. 
With SourceWB.Sheets("Report") 
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row 
    .Range("A2:F" & lRow).Copy 
End With 

'Active Merge Workbook 
ThisWorkbook.Activate 

'Paste. 
Columns("A").Find("", Cells(Rows.Count, "A")).Select 
Selection.PasteSpecial 

'Active CWPI Topic 1 Assessment Workbook 
SourceWB.Activate 

'Copy. 
With SourceWB.Sheets("Report") 
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 
.Range("G2:G" & lRow).Copy 
End With 

'Active Merge Workbook 
ThisWorkbook.Activate 

'Paste. 
Columns("G").Find("", Cells(Rows.Count, "G")).Select 
Selection.PasteSpecial 

Set ws1 = SourceWB.Sheets("Report") 
Set ws2 = DestWB.Sheets("Report") 
Set ws3 = DestWB.Sheets("Report") 
Set ws4 = DestWB.Sheets("Report") 

lastrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row 
Set range2 = ws2.Range("A2:A" & lastrow2) 
lastrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row 
Set range1 = ws1.Range("A2:A" & lastrow1) 
For Each c3ll2 In range2 

a = 0 
activerow2 = c3ll2.Row 
For Each c3ll1 In range1 
    If c3ll1.Value = c3ll2.Value Then 
     activerow1 = c3ll1.Row 
     Cells(activerow1, "H") = ws2.Cells(activerow2, 3) 
     Cells(activerow1, "I") = ws2.Cells(activerow2, 4) 
     Cells(activerow1, "J") = ws2.Cells(activerow2, 5) 
     Cells(activerow1, "K") = ws2.Cells(activerow2, 6) 
     Cells(activerow1, "L") = ws2.Cells(activerow2, 7) 
     a = 1             'Username is found 
     Exit For 
     End If 
Next c3ll1 
If a = 0 Then      'If Username is not found print at end 
    lastrow1 = lastrow1 + 1 
    Cells(lastrow1, "A") = ws2.Cells(activerow2, 1) 
    Cells(lastrow1, "B") = ws2.Cells(activerow2, 2) 
    Cells(lastrow1, "H") = ws2.Cells(activerow2, 3) 
    Cells(lastrow1, "I") = ws2.Cells(activerow2, 4) 
    Cells(lastrow1, "J") = ws2.Cells(activerow2, 5) 
    Cells(lastrow1, "K") = ws2.Cells(activerow2, 6) 
    Cells(lastrow1, "L") = ws2.Cells(activerow2, 7) 
End If 
Next c3ll2 

'Columns Width Autofit 
ActiveSheet.Columns.AutoFit 

With Application 
     Cells(.CountA(Columns("A:A")) + 1, 1).Select 
     .ScreenUpdating = True 
     .DisplayAlerts = False 
     SourceWB.Close 
     DestWB.Close 
End With 

End Sub 

Answer 1

을 시도이 그래서인가? 지금 당장은 당신이 생각하는 것처럼 DestWB의 3 가지 버전을 열지 않습니다.

: 대신

Set DestWB = Workbooks.Open(BookXPath) 

내가 길을 열려면 세 블록을 대체 할 것이다, 경로를 확인하고 다음으로 통합 문서 DestWB의 경로를 열 ... DestWB 전화 할 때마다 덮어 쓰는

'Create an array of paths, and a corresponding array of workbooks 
Dim paths() As String, wbs() as Workbook 
ReDim paths(3) 
'ReDim wbs to the same as path so its easier to adjust in the future 
ReDim wbs(UBound(paths)) 
'Set your paths, then loop through them to assign your workbooks 
Dim x as Integer 
For x = 1 To UBound(paths) 
    paths(x) = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Chapter " + CStr(x)) 
    If paths(x) = "False" Then 
      Exit Sub 
    End If 
    Set wbs(x) = Workbooks.Open(paths(x)) 
Next x 

동일한 루프 방법론을 사용하여이 매크로에서 다른 작업을 수행 할 수 있습니다. 또한 변수로 설정하여 ThisWorkbook의 활성화를 모두 제거 할 수 있습니다. 일반 ALL 기타 사항 서보 -OFF 및 선택에

Dim thisWB as Workbook 
Set thisWB = ThisWorkbook 

이 차례로이 코드를 정리하게됩니다

...이 코드에

Columns("A").Find("", Cells(Rows.Count, "A")).Select 
Selection.PasteSpecial 

...

thisWB.Sheets("SOMESHEET").Columns("A").Find("", Cells(Rows.Count, "A")).PasteSpecial 

피해야한다. stackoverflow 및 Google 주위 검색, 두 루프에 대한 예제가 많이 있으며 제거. 선택 및 선택.