将多个Excel工作簿合并到一个主列表中 [英] Merge multiple Excel workbooks into single masterlist
问题描述
我不确定以下代码,因为我不确定如何填充多个列和行.
I have the following code albeit incomplete as i am unsure how i can populate multiple columns and rows.
代码
Sub VlookMultipleWorkbooks()
Dim lookFor As Range
Dim srchRange As Range
Dim book1 As Workbook
Dim book2 As Workbook
Dim book1Name As String
book1Name = "destination.xls" 'modify it as per your requirement
Dim book1NamePath As String
book1NamePath = ThisWorkbook.Path & "\" & book1Name
Dim book2Name As String
book2Name = "source.xls" 'modify it as per your requirement
Dim book2NamePath As String
book2NamePath = ThisWorkbook.Path & "\" & book2Name
' Set book1 = ThisWorkbook
Set book1 = Workbooks(book1Name)
If IsOpen(book2Name) = False Then Workbooks.Open (book2NamePath)
Set book2 = Workbooks(book2Name)
Set lookFor = book1.Sheets(1).Cells(2, 1) ' value to find
Set srchRange = book2.Sheets(1).Range("A:B") 'source
lookFor.Offset(0, 1).Value = Application.VLookup(lookFor, srchRange, 2, False)
End Sub
我的源文件具有以下结构
My source file has the following structure
Name Value1
我的目标文件具有以下结构
My destination file has the following structure
Name Value1
问题1
当前代码仅填充单个单元格,我希望它填充允许行.
Currently the code only populates a single cell where i would like it to populate allow rows.
问题2
我需要能够填充多列.例如.
I need to be able to populate multiple columns. For example.
Name Value1 Value2, etc
问题3
有多个源文件需要合并到一个主列表中.
There are multiple source files that need to merge into a single master list.
推荐答案
编辑:您可以修改初始设计,以使用两个 Range
对象和一个偏移量,然后根据需要进行迭代.您需要打开工作簿并在其他地方分配 Range
对象,但这似乎并不是当前的挑战.(以下内容未经测试):
You could modify your initial design to take in two Range
objects and an offset, then iterate as necessary. You'll need to open your workbooks and assign the Range
objects elsewhere, but that doesn't seem to be the challenge right now. (Below is untested):
Sub EvenCoolerVLookup(SourceRange As Range, OffsetColumns As Long, LookupRange As Range)
Dim Cell As Range
'vet range objects and make sure they fail an Is Nothing test
'....
For Each Cell In SourceRange
'do any special prep here
'...
Cell.Offset(0, OffsetColumns).Value = Application.VLookup(Cell, LookupRange, 2, False)
'do any special cleanup here
'...
Next Cell
'do anything else here
'....
End Sub
这应该可以帮助您解决问题1 .要解决问题2 ,您将无法使用 Application.Vlookup
,但可以使用 Range.Find
返回 Range
对象,您可以通过 Range.Row
从中获取行.
That should help you solve Problem 1. To solve Problem 2, you won't be able to use Application.Vlookup
, but you can instead use Range.Find
to return a Range
object, from which you can grab the row via Range.Row
.
原始响应:这应该可以为问题3 合并源文件.结果将作为 xlsx
文件保存到与运行代码的文件相同的目录中:
Original Response: This should work to combine source files for Problem 3. The results will be saved as an xlsx
file to the same directory as the file from which the code is run:
Option Explicit
'let's do some combining y'all!
Sub CombineSelectedFiles()
Dim TargetFiles As FileDialog
Dim TargetBook As Workbook, CombinedBook As Workbook
Dim TargetSheet As Worksheet, CombinedSheet As Worksheet
Dim TargetRange As Range, AddNewRange As Range, _
FinalRange As Range
Dim LastRow As Long, LastCol As Long, Idx As Long, _
LastCombinedRow As Long
Dim CombinedFileName As String
Dim RemoveDupesArray() As Variant
'prompt user to pick files he or she would like to combine
Set TargetFiles = UserSelectMultipleFiles("Pick the files you'd like to combine:")
If TargetFiles.SelectedItems.Count = 0 Then Exit Sub '<~ user clicked cancel
'create a destination book for all the merged data
Set CombinedBook = Workbooks.Add
Set CombinedSheet = CombinedBook.ActiveSheet
'loop through the selected workbooks and combine data
For Idx = 1 To TargetFiles.SelectedItems.Count
Set TargetBook = Workbooks.Open(TargetFiles.SelectedItems(Idx))
Set TargetSheet = TargetBook.ActiveSheet
If Idx = 1 Then
TargetSheet.Cells.Copy Destination:=CombinedSheet.Cells(1, 1)
Else
LastRow = FindLastRow(TargetSheet)
LastCol = FindLastCol(TargetSheet)
With TargetSheet
Set TargetRange = .Range(.Cells(2, 1), .Cells(LastRow, LastCol))
End With
LastCombinedRow = FindLastRow(CombinedSheet)
With CombinedSheet
Set AddNewRange = .Range(.Cells(LastCombinedRow + 1, 1), _
.Cells(LastCombinedRow + 1 + LastRow, LastCol))
End With
TargetRange.Copy Destination:=AddNewRange
End If
TargetBook.Close SaveChanges:=False
Next Idx
'set up a final range for duplicate removal
LastCombinedRow = FindLastRow(CombinedSheet)
With CombinedSheet
Set FinalRange = .Range(.Cells(1, 1), .Cells(LastCombinedRow, LastCol))
End With
'populate the array for use in the duplicate removal
ReDim RemoveDupesArray(LastCol)
For Idx = 0 To (LastCol - 1)
RemoveDupesArray(Idx) = Idx + 1
Next Idx
FinalRange.RemoveDuplicates Columns:=Evaluate(RemoveDupesArray), Header:=xlYes
'save the results
CombinedFileName = ThisWorkbook.Path & "\Combined_Data"
Application.DisplayAlerts = False
CombinedBook.SaveAs FileName:=CombinedFileName, FileFormat:=51
CombinedBook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
'prompt user to select files then return the selected fd object
Public Function UserSelectMultipleFiles(DisplayText As String) As FileDialog
Dim usmfDialog As FileDialog
Set usmfDialog = Application.FileDialog(msoFileDialogOpen)
With usmfDialog
.AllowMultiSelect = True
.Title = DisplayText
.ButtonName = ""
.Filters.Clear
.Filters.Add ".xlsx files", "*.xlsx"
.Filters.Add ".xlsb files", "*.xlsb"
.Filters.Add ".xlsm files", "*.xlsm"
.Filters.Add ".xls files", "*.xls"
.Filters.Add ".csv files", "*.csv"
.Filters.Add ".txt files", "*.txt"
.Show
End With
Set UserSelectMultipleFiles = usmfDialog
End Function
'identify last row in a worksheet
Public Function FindLastRow(Sheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
FindLastRow = Sheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Else
FindLastRow = 1
End If
End Function
'identify last col in a worksheet
Public Function FindLastCol(Sheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
FindLastCol = Sheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Else
FindLastCol = 1
End If
End Function
这篇关于将多个Excel工作簿合并到一个主列表中的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!