Question

我有按地区，地区和期间划分的一系列工作簿，其中包含地区，地区和期间的每种组合的每月销售数据。每个地区都有一个主工作簿，其中包含每个地区的单独工作表。每月数据显示在B:M列中。

我需要打开每个每月的地区，地区和期间文件，打开相应的地区主工作簿，搜索相应的地区，然后将该月的数据粘贴到与该月份关联的列中（例如，2月数据）粘贴在C列中）。这之后应该关闭月度文件并循环到下一个月度文件。

但是，我需要编写代码，以便在年中时（在最初创建该区的主工作簿之后）将新领土添加到一个区中。

编写的循环希望从每月打开的文件跳转到循环代码的下一部分，这将创建新的工作表，但这不是必需的。

是否有解决此问题的建议？这是我到目前为止的内容：

Sub DSMReportsP02()

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    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 wsCount As Integer, x As Integer
    Dim wsExists As Boolean

    Set DistrictsDSMList = Range("E11:E" & Cells(Rows.Count, "E").End(xlUp).Row)
    Set WBMaster = ActiveWorkbook
    Period = Range("C6").Value
    YYYY = Range("C8").Value
    wsExists = False

    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

                    CurDstTerrFile.Sheets("Index").Range("J20").Copy 'XRA
                    DistMaster.Sheets(Territory).Activate
                    Range("C5").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("N20").Copy 'CO-OP
                    DistMaster.Sheets(Territory).Activate
                    Range("C7").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("S20").Copy 'VR
                    DistMaster.Sheets(Territory).Activate
                    Range("C9").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("W20").Copy 'OVER & ABOVE
                    DistMaster.Sheets(Territory).Activate
                    Range("C11").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("AA20").Copy 'SS
                    DistMaster.Sheets(Territory).Activate
                    Range("C13").PasteSpecial Paste:=xlPasteValues

                    CurDstTerrFile.Sheets("Index").Range("A3:D19").Copy 'COPY BTs by DISTRICT
                    WBMaster.Sheets("BTs by District").Activate
                    Range("A1000000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues

                    Exit For
                End If
            Next x

            If wsExists = False Then             '***********FIX THIS SECTION!!!*************************
                Worksheets.Add after:=DistMaster.Worksheets(Worksheets.Count)

                CurDstTerrFile.Sheets("Index").Range("A3").Copy 'COPY TERRITORY
                ActiveSheet.name = "New Territory"
                DistMaster.Sheets(Territory).Activate
                Range("A1").PasteSpecial Paste:=xlPasteValues
            End If

            Dim WS As Worksheet, SheetXXX As Worksheet
            Set WS = WBMaster.Sheets("ReptTemplate")
            WS.Copy after:=Sheets(WBMaster.Sheets.Count)

            Set SheetXXX = ActiveWorkbook.ActiveSheet
            SheetXXX.name = Worksheets("ReptTemplate").Range("A1").Value
            CurDstTerrFile.Close

        Loop

        Dim DistWS As Worksheet
        Dim DistName As String
        Dim wbNew As Workbook

        DistName = Left(DistrictDSM, 6) & "*"
        Set wbNew = Application.Workbooks.Add

        For Each DistWS In WBMaster.Sheets
            If DistWS.name Like DistName Then DistWS.Move after:=Sheets(wbNew.Sheets.Count)
        Next DistWS

        With wbNew
            .SaveAs "H:\Accounting\Monthend " & YYYY & "\DSM Files\DSM Master Reports\" & DistrictDSM & ".xlsx"
            .Close
        End With

    Next DistrictDSM

    Application.EnableEvents = True

End Sub

Answer 1

很抱歉，但我无法发表评论（声誉不足，无法对问题发表评论），否则在发布此帖子之前，我会问几个问题。

据我了解。您需要的是一种逻辑/算法，该逻辑/算法在开始向主文件的复制过程之前，检查是否需要向主文件中添加新的工作表（新区域）。如果需要添加工作表，则应将其添加到主文件的末尾。

下面的代码是常规代码，但是您应该可以轻松地对其进行调整以适合您的目的。下面的代码将 wb2 中的工作表与 wb1 进行了比较。如果 wb2 中的工作表名称在 wb1 中不存在，它将被添加到 wb1 末尾的新工作表中，其名称类似于 wb2 中的一个。

打开两个文件后，应立即放置此代码。

Sub Comapre_Sheets()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim bWorkSheet_Found As Boolean

Set wb1 = Workbooks("Book1") ''' Change this to the master file
Set wb2 = Workbooks("Book2") ''' Change this to the file that might have the new sheet/territory 

For Each wks2 In wb2.Worksheets

    bWorkSheet_Found = False

    For Each wks1 In wb1.Worksheets

        If wks1.name = wks2.name Then
            bWorkSheet_Found = True
        End If

    Next wks1

    If Not bWorkSheet_Found Then
        wb1.Worksheets.Add(After:=Worksheets(wb1.Sheets.Count)).name = wks2.name
    End If

Next wks2

End Sub

希望这对您有帮助

循环并在单独的Wkbks中搜索匹配的工作表；如果找不到匹配项，则添加Wksht

1 个答案: