excel - 粘贴时限定单元格中的 VBA 递增数

Question

我有一个宏，可以将"template"工作表中的许多行粘贴到事件工作表的下一个空白行中。

第一行的第 2 列是值“variable”。第一行第 6 列是一个 3 位数字。

我想要做的是在粘贴时将第 6 列中的数字增加 1。如果事件工作表上没有前面的数字，则它从 001 开始。

由于工作表中有其他不包含数字的行，并且带有数字的行不是固定间隔的，我认为需要按以下方式确定要递增的单元格(除非有更简单的逻辑) :

• 在事件工作表中，在第 2 列中找到值为“variable”的最后一行。将列偏移 4，以到达第 6 列中的单元格。

• 获取事件单元格值并在粘贴的行中递增 1，使用与上述相同的标准来确定哪个单元格。

• 如果第 2 列中没有“变量”的先前值，则值 = 001。

这是我用来粘贴到下一个空白行中的代码。

Sub Paste_New_Product_from_Template()
  Application.ScreenUpdating = False
  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet

  Set copySheet = Worksheets("Template")
  Set pasteSheet = ActiveSheet

  copySheet.Range("2:17").Copy
  pasteSheet.Cells(Rows.Count, 1).End(xlUp).OFFSET(1, 0).PasteSpecial xlPasteAll
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

我如何合并上述数字的递增？

编辑

这是模板表中行的示例

这就是 Sheet1 上的行的样子

Answer 1

Yes only incrementing Row 6. If no data in sheet then numbering starts from 001. Each sheet has independent numbering. If sheet has data then numbering starts from pasted row e.g. row 10. – aye cee

假设我们的示例数据如下所示

逻辑:

1. 设置输入/输出表。
2. 在输出表中找到要写入的最后一个单元格。必须检查之前是否有数据。
3. 如果没有数据，则复制整个标题行。
4. 复制范围。
5. 确定要写入第 6 列的下一个数字。
6. 在复制数据第 6 列的相关单元格中输入数字，并应用 000 格式。

代码:

这是您正在尝试的吗？我已经对代码进行了注释，因此您理解它应该没有问题，但如果您这样做，只需问问 :)

Option Explicit

Sub Paste_New_Product_from_Template()
    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet
    Dim LRow As Long, i As Long
    Dim StartNumber As Long
    Dim varString As String
    
    '~~> This is your input sheet
    Set copySheet = Worksheets("Template")
    '~~> Variable
    varString = copySheet.Cells(2, 2).Value2
    
    '~~> Change this to the relevant sheet
    Set pasteSheet = Sheet2
    
    '~~> Initialize the start number
    StartNumber = 1
    
    With pasteSheet
        '~~> Find the last cell to write to
        If Application.WorksheetFunction.CountA(.Cells) = 0 Then
            '~~> Copy header row
            copySheet.Rows(1).Copy .Rows(1)
            LRow = 2
        Else
            LRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            
            '~~> Find the previous number
            For i = LRow To 1 Step -1
                If .Cells(i, 2).Value2 = varString Then
                    StartNumber = .Cells(i, 6).Value2 + 1
                    Exit For
                End If
            Next i
        End If
        
        '~~> Copy the range
        copySheet.Range("2:17").Copy .Rows(LRow)
        
        '~~> Set the start number
        .Cells(LRow, 6).Value = StartNumber
        '~~> Format the number
        .Cells(LRow, 6).NumberFormat = "000"
    End With
End Sub

在行动