Question

注意：我最近问过这个问题，但没有得到所需的帮助，因此我再次提出了对问题和代码进行修改的问题。抱歉！

我在大约500个工作簿的系列中按地区，地区和期间（期间=月）获得MONTHLY数据。每个地区都有一个MASTER工作簿，每个地区都有单独的工作表，汇总了每月数据。

所需的过程是打开每个区的MASTER工作簿，打开每个区的MONTHLY文件，在MASTER工作簿中找到与MONTHLY文件中某个单元格中标识的地区匹配的Territory工作表，将每月数据粘贴到MASTER工作簿的Territory中工作表，关闭月度文件，然后循环到下一个月度文件。

但是，如果在最初创建“地区”主工作簿后的某个时间将地区添加到“地区”的“ MONTHLY”文件中，我们需要有代码来创建“新地区”工作表。

编写的代码不起作用，因为（似乎）它无法根据所有可能的MASTER工作簿Territory工作表名称正确评估当前的MONTHLY Territory名称。如果找到匹配项，则应复制，粘贴，关闭每月文件，然后循环到下一个MONTHLY文件。如果找不到匹配项，则应创建一个新的工作表，复制，粘贴，关闭每月文件，然后循环到下一个MONTHLY文件。有解决此问题的建议吗？

子DSMReportsP02（）

Dim DistrictDSM As Range, DistrictsDSMList As Range
Dim Period As String, Path As String, DistPeriodFile As String, Territory As String
Dim YYYY As Variant
Dim WBMaster As Workbook, DistMaster As Workbook, CurDstTerrFile As Workbook
Dim wsFind As Worksheet, SheetXXX As Worksheet
Dim wsCount As Integer, x As Integer
Set WBMaster = ActiveWorkbook
Period = Range("C6").Value
YYYY = Range("C8").Value

Set DistrictsDSMList = Range("E11:E" & Cells(Rows.Count, "E").End(xlUp).Row)

For Each DistrictDSM In DistrictsDSMList.Cells
    Workbooks.Open Filename:="H:\Accounting\Monthend " & YYYY & "\DSM Files\DSM Master Reports\" & DistrictDSM & ".xlsx"
    Set DistMaster = ActiveWorkbook
    wsCount = Application.Sheets.Count
    Path = "H:\Accounting\Monthend " & YYYY & "\DSM Files\" & DistrictDSM & "\P02"
    DistPeriodFile = Dir(Path & "\*.xlsx")

   Do While DistPeriodFile <> ""
        Workbooks.Open Filename:=Path & "\" & DistPeriodFile, UpdateLinks:=False
        DistPeriodFile = Dir
        Set CurDstTerrFile = ActiveWorkbook
        Territory = CurDstTerrFile.Sheets("Index").Range("A3").Value

        For x = 1 To wsCount
         If DistMaster.Worksheets(x).name = Territory Then
          CurDstTerrFile.Sheets("Index").Range("F20").Copy 'PM
          DistMaster.Sheets(Territory).Activate
             Range("C3").PasteSpecial Paste:=xlPasteValues
         End If

         If DistMaster.Worksheets(x).name <> Territory Then
          CurDstTerrFile.Sheets("Index").Range("F20").Copy 'PM
          WBMaster.Sheets("ReptTemplate").Activate
             Range("C3").PasteSpecial Paste:=xlPasteValues
          WBMaster.Sheets("ReptTemplate").Copy after:=DistMaster.Sheets(DistMaster.Sheets.Count)
          DistMaster.Sheets("ReptTemplate").name = DistMaster.Sheets("ReptTemplate").Range("A1").Value
         End If
        CurDstTerrFile.Close
        Next x
    Loop
  Next DistrictDSM
End Sub

Answer 1

我相信以下内容可以满足您的期望，值得一提的是，在使用各种工作簿/工作表时，特别建议完全限定范围，以免在引用ActiveSheet时混淆代码，所以我将进一步修改代码，以确保每个范围都指向所需的工作簿/工作表：

Sub DSMReportsP02()
Dim DistrictDSM As Range, DistrictsDSMList As Range
Dim Path As String, DistPeriodFile As String, Territory As String, YYYY As String
Dim WBMaster As Workbook, DistMaster As Workbook, CurDstTerrFile As Workbook
Dim wsCount As Integer, x As Integer
Dim FoundFlag As Boolean
Set WBMaster = ThisWorkbook
Period = Range("C6").Value
YYYY = Range("C8").Value
FoundFlag = False

Application.ScreenUpdating = False
    Set DistrictsDSMList = Range("E11:E" & Cells(Rows.Count, "E").End(xlUp).Row)

    For Each DistrictDSM In DistrictsDSMList.Cells
        Set DistMaster = Workbooks.Open("H:\Accounting\Monthend " & YYYY & "\DSM Files\DSM Master Reports\" & DistrictDSM & ".xlsx")
        wsCount = DistMaster.Sheets.Count
        Path = "H:\Accounting\Monthend " & YYYY & "\DSM Files\" & DistrictDSM & "\P02"
        DistPeriodFile = Dir(Path & "\*.xlsx")

        Do While DistPeriodFile <> ""
            Set CurDstTerrFile = Workbooks.Open(Path & "\" & DistPeriodFile)
            DistPeriodFile = Dir
            Territory = CurDstTerrFile.Sheets("Index").Range("A3").Value

            For x = 1 To wsCount
                If DistMaster.Worksheets(x).Name = Territory Then
                    FoundFlag = True 'set flag to found if worksheet found
                    DistMaster.Sheets(Territory).Range("C3").Value = CurDstTerrFile.Sheets("Index").Range("F20").Value 'PM
                End If
            Next x
            If FoundFlag = False Then 'if worksheet not found then add it
                WBMaster.Sheets("ReptTemplate").Range("C3").Value = CurDstTerrFile.Sheets("Index").Range("F20").Value 'PM
                WBMaster.Sheets("ReptTemplate").Copy After:=DistMaster.Sheets(DistMaster.Sheets.Count)
                DistMaster.Sheets("ReptTemplate").Name = DistMaster.Sheets("ReptTemplate").Range("A1").Value
            End If
            CurDstTerrFile.Close
            FoundFlag = False 'reset the flag before next iteration of the loop
        Loop
    Next DistrictDSM
Application.ScreenUpdating = True
End Sub

在其他工作簿中搜索工作表；如果找不到匹配项，则添加工作表

1 个答案: