Excel根据变量合并两个文件

Question

我想编写一个程序来匹配两个单独工作簿中的变量名称，而不是将变量中的所有信息复制到两个工作簿中的分页符到一个新工作中。每个工作簿都有多个分页符而不是工作表。 例如：

Workbook A (Variable = X)    
Persons          Name  
X                    Bill  

Work Book B  
Persons          Nickname  
X                   Billy  

New Workbook  
Page 1  
Persons          Name  
X                   Bill  

Page 2   
Persons          Nickname  
X                  Billy  

我使用site 处的代码合并两个选定的工作簿，但我不知道如何按名称进行匹配，而不是复制到分页符。任何人都可以有建议或可以帮助指导我吗？ 谢谢！

代码： 这是不正确的，但我试图使用 Vlookup 来查找工作表中的至少一个值

MergeSelectedWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim VariableX As Variant

    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    ' Modify this folder path to point to the files you want to use.
    FolderPath = "C:\Users\Documents\Test"

    ' Set the current directory to the the folder path.
    ChDrive FolderPath
    ChDir FolderPath
    SelectedFiles = Application.GetOpenFilename( _
        filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1

    ' Loop through the list of returned file names
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        ' Set FileName to be the current workbook file name to open.
        FileName = SelectedFiles(NFile)

        ' Open the current workbook.
        Set WorkBk = Workbooks.Open(FileName)

        ' Set the cell in column A to be the file name.
        SummarySheet.Range("A" & NRow).Value = FileName

        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks. It can span multiple rows.
        Set SourceRange = VBAVlookup(2, WorkBk.Worksheets(1).Range("A1:A25"), 2, False)

        ' Set the destination range to start at column B and be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
    Next NFile

    ' Call AutoFit on the destination sheet so that all data is readable.
    SummarySheet.Columns.AutoFit

    End Sub

Function VBAVlookup(ByVal search As Variant, _
                    cell_range As Range, _
                    offset As Long, _
                    Optional opt As Boolean = False)

Dim result As Variant
result = WorksheetFunction.VLookup(search, cell_range, offset, opt)
'do some cool things to result

VBAVlookup = result

End Function

Answer 1

由于您需要为每个变量组合信息，我猜一个变量在至少一个工作簿中只存在一次？换句话说，在合并工作簿之间之前，您不需要在工作簿中合并信息，对吗？

如果是这种情况，并且一个工作簿只列出每个变量（可能还有该变量的附加信息）一次，您可以在工作簿之间搜索时将其用作基本工作簿。

以下是一些让事情顺利进行的一般指示：

使用 Excel-VBA 代码，打开工作簿：

'define the input filepath
Dim inputfilepath As String
'define workbook name where variable info is located
Dim workbookTitle As String
workbookTitle = "Workbook1"

'this creates a filepath, filename, and file extension.
'if not ".xls", change to make appropriate
inputfilepath = ActiveWorkbook.Path & "\" & workbookTitle & ".xls"

'open comparing workbook. see .OpenText method documentation for
'more details and options
Workbooks.OpenText Filename:=inputfilepath, Origin:= _
  xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
  xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
  Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
  Array(2, 1)), TrailingMinusNumbers:=True

如何找到变量？您提到使用VLOOKUP，这很好。但在这种情况下，由于您使用的是 Excel-VBA，我建议您使用 Range.Value 属性。您可以使用for 循环遍历基础工作簿中的每个变量。

如何确定该变量是否存在于不同的工作簿中？然后使用另一个 for 循环搜索该变量，嵌套在第一个 for 循环中：

'find the variable.
'here, it's assumed variable on first line
Dim myVar As String

'1st for loop
'w needs to be assigned to the appropriate workbook,
'and s needs to be assigned to the appropriate worksheet
For varRow = 2 To Workbooks(w).Worksheets(s).UsedRange.Rows.Count

    'assign the variable name to "myVar"
    myVar = Workbooks(w).Worksheets(s).Range(Cells(varRow, 0)).Value

    'nested for loop
    'similar to parent for loop, w2 needs to be assigned to the
    'appropriate workbook for finding additional variable info,
    'and s2 needs to be assigned to the appropriate worksheet
    For varRow2 = 2 To Workbooks(w2).Worksheets(s2).UsedRange.Rows.Count

        'assign the variable under inspection in the comparison
        'worksheet to "compareVar."
        compareVar = Workbooks(w2).Worksheets(s2).Range(Cells(varRow2, 0)).Value

        'perform StrComp to compare myVar and compareVar, and see
        'if a match.
        If StrComp(CStr(myVar), CStr(campareVar)) <> 0 Then

            'code for merging values here, since this
            'will execute if the variables match

        End If

    Next

Next

我使用StrComp 函数来查看另一个工作簿中是否存在变量名。我还使用.UsedRange.Rows.Count 来定义 for 循环的限制，因为这是在工作表中定义工作范围的一种方法。 for 循环只是逐行遍历，查看该行中的信息。该框架可以适应工作簿中信息的设置方式。

现在这是逐行进行的，但是您如何逐页进行分页？感谢this SO answer，您可以遍历分页符。我已经从上面更改了第一个for 循环，因此它利用了分页符搜索的优势。将此与上面的代码进行比较，看看它是如何变化的。这也可以适应细节：

'1st for loop
'w needs to be assigned to the appropriate workbook,
'and s needs to be assigned to the appropriate worksheet
For Each pgBreak In Workbooks(w).Worksheets(s).HPageBreaks

    'assuming the variable is immediately after a pagebreak,
    'assign the variable name to "myVar"
    myVar = Workbooks(w).Worksheets(s) _
    .Range(Cells(pgBreak.Location.Row + 1, 0)).Value

希望所有这些对您有所帮助并让事情顺利进行。