Excel VBA使用附加行填充模板

也许有人知道如何在VBA中执行这些操作： 我在一张纸上有一个模板，在第二张纸上有一张桌子。 表如下所示：

Unit    Project Project Name   Task Number   Invoice    Sum of Amount
304     136950  Name1               02.3    invoice1    156.45
304     136955  Name2               01.6    invoice1    22.35

所以，当我填写模板时，我需要检查单元名称是否相同，如果相同，则应在模板中创建额外的行

目前，我有一个宏，它只为一行单独完成模板，而我的问题是，如果我创建一个检查，仍然是因为“for Each…”我面临着创建新图纸而不是行的问题

由于我是VBA新手，是否有可能帮助我解决这个问题，例如，如果单位在1+行上是相同的（按单位设置的顺序，因此不会出现单位在降低几行后重复的情况），而不是使用填充模板创建新图纸，则会在模板中创建新行

我现在有：

  Set myRange = Range(Sheets("Data").Cells(2, 1), Sheets("Data").Cells(2, 1).End(xlDown))

i = 1

For Each r In myRange.Cells


Sheets("template").Select
Sheets("template").Copy Before:=Sheets(1)
Sheets("template (2)").Select
Sheets("template (2)").Name = "Invoice " & i
Range("C1:D1").Select



ActiveSheet.Cells.Replace What:="{Unit}", Replacement:=r.Offset(0, 0), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False


ActiveSheet.Cells.Replace What:="{pr number}", Replacement:=r.Offset(0, 1), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

ActiveSheet.Cells.Replace What:="{pr name}", Replacement:=r.Offset(0, 2), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False


 ActiveSheet.Cells.Replace What:="{task nr}", Replacement:=r.Offset(0, 3), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

 ActiveSheet.Cells.Replace What:="{invoice number}", Replacement:=r.Offset(0, 4), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

ActiveSheet.Cells.Replace What:="{amount}", Replacement:=r.Offset(0, 5), LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False

i = i + 1

   Next r 

应复制为新行的范围存储在此处：

Range("A24:H29").Select 'templated data, which should be copied if new row needed and then here I'm fulfilling info from table
Selection.Copy
Range("A31").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = j + 1 'line number
Range("A33").Select

---

您可以使用

For循环

。存储一个唯一的单元名称（例如304），然后比较后续行（如果匹配）。找到不匹配后，您就知道不匹配上面的一行，存储的唯一值的范围结束。然后将该范围复制到新创建的图纸

Sub CreateNewTemplates()
    Dim wsTable As Worksheet
    Dim wsNewTemplate As Worksheet
    Dim rngStoredUnique As Range

    Set wsTable = Worksheets("Table") 'worksheet where all the data is
    With wsTable
        For x = 1 To 50 'adjust to your needs
            Set rngStoredUnique = .Cells(x, 1) 'adjust to your needs
            Sheets("template").Copy after:=Sheets("template") 'adjust to your needs
            Set wsNewTemplate = ActiveSheet
            wsNewTemplate.Name = "Invoice " & rngStoredUnique.Value 'adjust to your needs
            For y = 1 To 50 - x 'adjust to your needs
                If rngStoredUnique <> rngStoredUnique.Offset(y, 0) Then 'check if the unit below is different than stored
                    Set rngToCopy = .Range(rngStoredUnique, rngStoredUnique.Offset(y - 1, 0)).Resize(ColumnSize:=10) 'adjust to your needs
                    x = x + y - 1
                    rngToCopy.Copy Destination:=wsNewTemplate.Cells(1, 1) 'adjust to your needs
                    If rngStoredUnique.Offset(y, 0) = "" Then Exit Sub
                    Exit For
                End If
            Next y
        Next x
    End With
End Sub

子CreateNewTemplates（）
将wsTable设置为工作表
将wsNewTemplate设置为工作表
变暗RNGSTOREDUNIKE As范围
设置wsTable=工作表（“表格”）工作表，其中包含所有数据
带wsTable
对于x=1至50’，根据您的需要进行调整
设置rngStoredUnique=.Cells（x，1）'根据您的需要进行调整
工作表（“模板”）。之后复制：=工作表（“模板”）'根据您的需要进行调整
设置wsNewTemplate=ActiveSheet
wsNewTemplate.Name=“Invoice”&rngStoredUnique.Value“根据您的需要进行调整”
对于y=1到50-x’，根据您的需要进行调整
如果rngStoredUnique rngStoredUnique.偏移量（y，0），则“检查以下单位是否与存储单位不同
设置rngToCopy=.Range（rngStoredUnique，rngStoredUnique.Offset（y-1，0））。调整大小（ColumnSize:=10）“根据需要进行调整”
x=x+y-1
rngToCopy.Copy Destination:=wsNewTemplate.Cells（1,1）'根据您的需要进行调整
如果rngStoredUnique.Offset（y，0）=“”，则退出子系统
退出
如果结束
下一个y
下一个x
以
端接头

是否要用唯一的单位值填充模板表（模板表中的一行等于表中的一个唯一单位）？因此，例如有10x单位

304

、3x单位

308

和20x单位

401

，模板将为每个

304

308

401

有一行？这就是问题所在吗？嗨，是的，没错，所以模板的数据正在移动到新的表格中，对于每个独特的单元，我需要在模板中添加额外的行，以及上面表格中的已完成数据，例如，从您的示例来看，304中有10行，下一个模板3x308等等。啊哈，所以模板表格更像是每个单元的摘要，有这个单位的所有记录。每个单元将有一个模板表。对的是的，我有一个叫做模板（预定义）的表单，我已经定义了所有的{Unit}，{project nr}，所以我只需要相应地完成它。