VBA Excel 从模板和列表生成唯一页面答案

【问题标题】：VBA Excel Generate Unique Pages From Template and ListVBA Excel 从模板和列表生成唯一页面
【发布时间】：2015-02-25 03:34:54
【问题描述】：

我已经为此工作了一段时间（我根本没有 VBA 经验），但我不断收到错误，所以我们就在这里。

设置： 为简单起见，我在工作簿中有两个工作表。第一个“每日订单”是我所有产品的列表，每一行是不同的产品（大约 1,000 个），每列表示有关产品的不同信息（即 ID、成本、重量等）。
第二个，“模板”，是一个定价模板，当给定产品信息时，它将生成一个定价表。

目标： 创建一个 VBA 宏以遍历“每日订单”工作表的每一行，并为每一行复制模板表并将某些信息附加到该新表。

什么不起作用：

Sub GeneratePriceBook()

Dim rw As Range

Dim temp As Worksheet
Dim ws As Worksheet
Dim daily As Worksheet

Set daily = Worksheets("Daily Order")
Set temp = Worksheets("Template")

temp.Activate

For Each rw In daily.Rows
    temp.Copy After:=Sheets(Sheets.Count)

    Set ws = Sheets(Sheets.Count)

    ws.Name = rw.Value

    With ws
        .Range("A6").Formula = "='Daily Order'!B" & rw.Row
        .Range("B6").Formula = "='Daily Order'!B" & rw.Row
        .Range("A3").Formula = "='Daily Order'!Q" & rw.Row
        .Range("E36").Formula = "='Daily Order'!M" & rw.Row
        .Range("E36").Formula = "='Daily Order'!Y" & rw.Row
        .Range("E37").Formula = "='Daily Order'!L" & rw.Row
    End With

Next rw

End Sub

错误类型：

我花了相当多的时间试图隔离出我认为可能有问题的某些区域，但我总是以 424 错误或 1004 错误告终。

再次感谢您的帮助。谢谢！

【问题讨论】：

您的系统内存使用量是多少？您在此操作中创建了数千张工作表。
@enderland 内存使用不是问题（还），我的代码在第一个工作表重复时抛出错误。这些错误似乎都与新工作表有关。当我尝试以任何方式对其采取行动时，它告诉我它不是一个对象（通过发出 1004 或 424 错误）
在定义 temp/daily 时尝试将 worksheets 更改为 sheets。
仍然出现 424 错误
适用于更通用的应用程序stackoverflow.com/a/49706073/9410024

标签： vba excel

【解决方案1】：

我想这就是你要找的东西：

Sub GeneratePriceBook()

    Dim wsDaily As Worksheet
    Dim wsTemp As Worksheet
    Dim lVisibility As XlSheetVisibility
    Dim strSheetName As String
    Dim rIndex As Long
    Dim i As Long

    Set wsDaily = Sheets("Daily Order")
    Set wsTemp = Sheets("Template")

    lVisibility = wsTemp.Visible          'In case template sheet is hidden
    wsTemp.Visible = xlSheetVisible

    For rIndex = 2 To wsDaily.Cells(Rows.Count, "A").End(xlUp).Row
        'Ensure valid sheet name
        strSheetName = wsDaily.Cells(rIndex, "A").Text
        For i = 1 To 7
            strSheetName = Replace(strSheetName, Mid(":\/?*[]", i, 1), " ")
        Next i
        strSheetName = Trim(Left(WorksheetFunction.Trim(strSheetName), 31))

        'Make sure the sheet name doesn't already exist
        If Not Evaluate("IsRef('" & strSheetName & "'!A1)") Then
            wsTemp.Copy After:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = strSheetName
                .Range("A6").Formula = "='" & wsDaily.Name & "'!B" & rIndex
                .Range("B6").Formula = "='" & wsDaily.Name & "'!B" & rIndex     'You are referencing the same cell as in A6?
                .Range("A3").Formula = "='" & wsDaily.Name & "'!Q" & rIndex
                .Range("E36").Formula = "='" & wsDaily.Name & "'!M" & rIndex
                .Range("E36").Formula = "='" & wsDaily.Name & "'!Y" & rIndex    'You are putting a second formula in E36?
                .Range("E37").Formula = "='" & wsDaily.Name & "'!L" & rIndex
            End With
        End If
    Next rIndex
    wsTemp.Visible = lVisibility  'Set template sheet to its original visible state

    Set wsDaily = Nothing
    Set wsTemp = Nothing

End Sub

【讨论】：