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

希望这一切都有所帮助，让事情顺利进行。

Excel基于变量合并两个文件

1 个答案: