Сравнить и обновить основные рабочие листы, если они существуют в другой рабочей книге? - PullRequest
0 голосов
/ 02 марта 2020

У меня есть основная рабочая книга, в которой находится группа из 15 рабочих таблиц, в которых хранятся данные сводных сводных таблиц и тому подобное. Каждую неделю эта главная рабочая книга обновляется ежедневным отчетом, в котором есть эти 15 листов, а также около 20 других. Я просто пытаюсь собрать сценарий, чтобы определить, существуют ли они, и если да, переместить эти ежедневные данные на рабочий лист главной книги (перемещать данные, только если master workbook существует в *1002*).

Вот очень общая оболочка того, чего я пытаюсь достичь, но я не очень хорошо разбираюсь в определении логики c, если лист существует, поэтому моя переменная blnFound явно неуместна. Я надеюсь, что это показывает грубую схему того, чего я пытаюсь достичь. Любая помощь с благодарностью!

Option Explicit
Sub Update_New_Data()
    Const BasePath As String = "C:\\User\Data..."

    Dim wbMaster As Workbook: Set wbMaster = ThisWorkbook
    Dim wbNewData As Workbook: Set wbNewData = Workbooks.Open(BasePath & "\03.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

1 Ответ

1 голос
/ 02 марта 2020

Чтобы проверить, существует ли что-то, вы можете использовать Словарь объекта

Option Explicit
Sub Update_New_Data()

    Const BasePath As String = "C:\\User\Data..."

    Dim wbMaster As Workbook, wbNewData As Workbook
    Set wbMaster = ThisWorkbook
    Set wbNewData = Workbooks.Open(BasePath & "\03.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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...