如果主工作表存在于其他工作簿中，是否进行比较和更新

Question

我有一个主工作簿，其中包含一组15个工作表，其中包含汇总数据透视表等的数据。每周，这个主工作簿都会更新一份日报，其中有这15个工作表，还有大约20个其他工作表。我只是试图将一个脚本组合在一起，以确定它们是否存在，如果存在，则将每日数据移动到主工作簿工作表中(仅当daily wb worksheet存在于master workbook中时才移动数据(。

这是我试图实现的一个非常一般的外壳，但我不太擅长确定是否存在表的逻辑，所以我的blnFound变量显然放错了地方。我希望这能大致说明我正在努力实现的目标。非常感谢您的帮助！

Option Explicit
Sub Update_New_Data()
Const BasePath As String = "C:\UserData..."
Dim wbMaster As Workbook: Set wbMaster = ThisWorkbook
Dim wbNewData As Workbook: Set wbNewData = Workbooks.Open(BasePath & "3.01.20.xlsx")
Dim wsMaster As Sheet
Dim blnFound As Boolean
'places all sheet names into array
With wbNewData
Dim varWsName As Variant
Dim i As Long
Dim ws As Worksheet
ReDim varWsName(1 To wbNewData.Worksheets.Count - 2)
For Each ws In wbNewData.Worksheets
Select Case ws.Name
Case "Inputs", "Data --->>>"
Case Else
i = i + 1
varWsName(i) = ws.Name
End Select
Next
End With
'if wbNewData sheet name is found in wbMaster
'then locate it and place wbNewData data into that sheet
With wbMaster
For Each wsMaster In wbMaster.Sheets
With wsMaster
If .Name = varWsName(i) Then
blnFound = True
wbNewData(Worksheets(i)).UsedRange.Copy Destination:=wbMaster(Worksheets(i)).Range("A1")
Else: blnFound = False
End If
End With
Next
End With

End Sub

Answer 1

要检查是否存在某种东西，可以使用字典对象

Option Explicit
Sub Update_New_Data()
Const BasePath As String = "C:\UserData..."
Dim wbMaster As Workbook, wbNewData As Workbook
Set wbMaster = ThisWorkbook
Set wbNewData = Workbooks.Open(BasePath & "3.01.20.xlsx", , False) ' read only
Dim ws As Worksheet, sKey As String, rng As Range, msg As String
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
'places all master sheet names into dictionary
For Each ws In wbMaster.Sheets
If ws.Name = "inputs" Or ws.Name = "Data --->>>" Then
' skip
Else
dict.Add CStr(ws.Name), ws.Index
Debug.Print "Added to dict", ws.Index, ws.Name
End If
Next
' if wbNewData sheet name is found in wbMaster
' then locate it and place wbNewData data into that sheet
For Each ws In wbNewData.Sheets
sKey = CStr(ws.Name)
If dict.exists(sKey) Then
' clear master
wbMaster.Sheets(dict(sKey)).cells.clear
Set rng = ws.UsedRange
rng.Copy wbMaster.Sheets(dict(sKey)).Range("A1")
msg = msg & vbCr & ws.Name
Else
Debug.Print "Not found in master", ws.Index, ws.Name
End If
Next
wbNewData.Close
' result
If Len(msg) > 0 Then
MsgBox "Sheets copied were " & msg, vbInformation
Else
MsgBox "No sheets copied", vbExclamation
End If
End Sub