Есть ли код VBA, который сохраняет несколько шаблонов (с предопределенной структурой) для каждого уникального значения в указанных данных столбца - PullRequest
0 голосов
/ 20 декабря 2018

Я ищу помощь VBA, где у меня есть предварительно разработанный структурированный шаблон Excel с 5 вкладками.Одной из вкладок является вкладка «Данные», которая содержит сведения о 10 разделах (названия разделов находятся в столбце А вкладки «Данные»).Остальные все вкладки связаны между собой вкладкой «Данные» и другими вкладками с помощью формул, сводных диаграмм и диаграмм.Я хочу создать код, который будет создавать / копировать этот шаблон с данными отдельных разделов.

Ключевые моменты, на которые следует обратить внимание:

  1. Код должен использовать тот же шаблон, чтобы поддерживать целостность(формат, защита, диаграммы и т. д.) и связанные формулы на всех вкладках (поэтому может потребоваться использовать функцию save.as)
  2. Необходимо сохранить главный шаблон
  3. Каждый разделшаблон должен содержать данные только для этого раздела

    Любые ссылки будут высоко оценены

Я пробовал код, который помогает создавать несколько рабочих листов, но мне нужно создавать рабочие книги, сохраняяВесь формат мастер-шаблона.

Sub parse_data()
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Dim Sht As Worksheet
    Dim strPwd As String
    Dim strCheck As String
    strCheck = "ABC"
    strPwd = InputBox("Enter Password", "Password", "")

    If strPwd = strCheck Then
        For Each xxx In ThisWorkbook.Worksheets
            xxx.Unprotect strPwd
    Next xxx
    Else
        MsgBox "Incorrect Password"
    End If
    '-----------------------------------------------
    For Each xSht In Application.ActiveWorkbook.Worksheets
       If xSht.Name <> "Index" And xSht.Name <> "Combine" And xSht.Name <> "Long Position Current Month" And xSht.Name <> "Long Position Prior Month" Then
       Application.DisplayAlerts = False
          xSht.Delete
       End If
    Next
    Worksheets("Long Position Current Month").Activate
    Set xSht = ActiveSheet
    On Error Resume Next
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
    xTitle = "A1:CZ1"
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For I = 3 To xRCount
        Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For I = 1 To xCol.Count
        Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = CStr(xCol.Item(I))
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
        xNSht.Range("2:2").Select
        Selection.AutoFilter
        xNSht.AutoFilter = True
        xNSht.AutoFilterMode = True
        xNSht.Range("A3:AA50000").Select
            Selection.Locked = False
            Selection.FormulaHidden = False
        xNSht.Range("A3").Select
            ActiveWindow.FreezePanes = True
        xNSht.Protect Password:="ABC", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
    Next
    xSht.AutoFilterMode = True
    xSht.AutoFilter.ShowAllData
    'Sheets(Array("Combine", "Long Positions")).Select
    'ActiveWindow.SelectedSheets.Visible = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
End Sub

С 10 уникальными значениями в данном столбце - 10 шаблонов создаются только с данными для соответствующих значений.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...