比較不同的Excel工作簿的Sheetnames並且在第三片材存儲結果

Question

存在其中我們有三個Excel工作簿文件夾： -

1. 組A（其具有片材的n個）
2. SETB（其中有張n個）
3. 差異

我想有「差異」的按鈕，點擊它會組A的工作表名稱比較該組B和存儲的結果差異。

例如： - 我實際上需要將數據與2個工作簿（即SetA和SetB）進行比較。但是，這種比較必須在表單上才能看出，如果SetA有2張名爲「India」和「America」的表，並且setB有2張名爲「India」和「Football」的表，那麼我的宏應該首先比較表的名稱，如果它匹配，然後只有它應該比較其數據。所以應該發生「印度」的數據比較，並且不應該發生「足球」。

我需要提交它今晚，我來自純數據庫背景。

我是全新的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