比较不同 Excel 工作簿的工作表名称并将结果存储在第三张工作表中

Question

有一个文件夹，其中我们有三个 excel 工作簿：-

1. setA（有n张）
2. SetB（有n张）
3. 区别

我想在“Difference”中有一个按钮，点击它会将SetA的工作表名称与SetB的工作表名称进行比较，并将结果存储为Difference。

示例：- 我实际上需要将数据与 2 个工作簿（即 SetA 和 SetB）进行比较。但是这种比较必须在表格上进行，例如如果 SetA 有 2 张名为“India”和“America”的表格，而 setB 有 2 张名为“India”和“Football”的表格，那么我的宏应该首先比较表格的名称，如果它匹配然后只有它应该比较它的数据。所以“印度”的数据比较应该发生，“足球”不应该发生。

我今晚需要提交，我是纯DB背景。

我对excel完全陌生，你能指导一下如何实现它吗？

Answer 1

在这里，这将满足您的需求。

Option Explicit
Sub FileListingAllFolder()

Dim pPath As String
Dim FlNm As Variant
Dim ListFNm As New Collection ' create a collection of filenames

Dim OWb As Workbook
Dim ShtCnt As Integer
Dim Sht As Integer

Dim MWb As Workbook
Dim MWs As Worksheet
Dim i As Integer

' Open folder selection
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    pPath = .SelectedItems(1)
End With

Application.WindowState = xlMinimized
Application.ScreenUpdating = False

' Create master workbook with single sheets
Set MWb = Workbooks.Add(1)
MWb.Sheets(1).Name = "Result"
Set MWs = MWb.Sheets("Result")
Cells(1, 1) = "No."
Cells(1, 2) = "Sheet Name"
Cells(1, 3) = "File Name"
Cells(1, 4) = "Link"
i = 2

' Filling a collection of filenames (search Excel files including subdirectories)
Call FlSrch(ListFNm, pPath, "*.xls", True)

' Print list to immediate debug window and as a message window
For Each FlNm In ListFNm ' cycle for list(collection) processing

    'Start Processing here
    Set OWb = Workbooks.Open(FlNm)
    ShtCnt = ActiveWorkbook.Sheets.Count
    For Sht = 1 To ShtCnt
        MWs.Cells(i, 1) = i - 1
        MWs.Cells(i, 2) = Sheets(Sht).Name
        MWs.Cells(i, 3) = OWb.Name
        MWs.Cells(i, 4).Formula = "=HYPERLINK(""" & FlNm & """,""Click Here"")"
        i = i + 1
    Next Sht
    'End file processing file
    OWb.Close False
Next FlNm

' Print to immediate debug window and message if no file was found
If ListFNm.Count = 0 Then
    Debug.Print "No file was found !"
    MsgBox "No file was found !"
    MWb.Close False
    End
End If

MWb.Activate
MWs.Activate
Cells.Select
Selection.EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
Application.WindowState = xlMaximized

End

NextCode:
MsgBox "You Click Cancel, and no folder selected!"

End Sub

Private Sub FlSrch(pFnd As Collection, pPath As String, pMask As String, pSbDir As Boolean)

Dim flDir As String
Dim CldItm As Variant
Dim sCldItm As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
flDir = Dir(pPath & pMask)
    Do While flDir <> ""
        pFnd.Add pPath & flDir 'add file name to list(collection)
        flDir = Dir ' next file
    Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pSbDir Then Exit Sub

' Searching for subdirectories in path
flDir = Dir(pPath & "*", vbDirectory)
    Do While flDir <> ""

        ' Add subdirectory to local list(collection) of subdirectories in path
        If flDir <> "." And flDir <> ".." Then If ((GetAttr(pPath & flDir) And _
        vbDirectory) = 16) Then sCldItm.Add pPath & flDir
        flDir = Dir 'next file
    Loop

' Subdirectories list(collection) processing
For Each CldItm In sCldItm
    Call FlSrch(pFnd, CStr(CldItm), pMask, pSbDir) ' Recursive procedure call
Next

End Sub