Question

我正在寻找VBA帮助，那里有一个带有5个选项卡的预先设计的结构化excel模板。选项卡之一是“数据”选项卡，其中包含10个节的详细信息（节名称在“数据”选项卡的A列中）。其余所有选项卡都通过公式，数据透视图和图表与“数据”选项卡和其他选项卡相互链接。我想构建一个代码，该代码将使用单独的部分数据创建/复制此模板。

要注意的重要事项：

代码需要使用相同的模板，以维护所有标签中的完整性（格式，保护，图表等）和相互关联的公式（因此可能需要使用save.as函数）
需要保留主模板
每个部分模板仅应具有该部分的数据

任何潜在客户都会受到高度赞赏

我尝试了有助于创建多个工作表的代码，但是我需要创建保留所有主模板格式的工作簿。

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个模板。

是否有VBA代码可以将指定列数据中的每个唯一值另存为多个模板（具有预定义的结构）

0 个答案: