VBA 粘贴时合格单元格中的递增数字

Question

我有一个宏，可以将“模板”sheet 中的许多行粘贴到活动 sheet 上的下一个空白行中。

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

我想要做的是在粘贴时将第 6 列中的数字增加 1。如果活动sheet上没有前面的号码，那么它从001开始。

由于sheet有其他行不包含数字，并且有数字的行不是固定间隔的，我认为需要按以下方式确定要递增的单元格（除非有一个更简单的逻辑）：

在活动 Sheet 中，找到第 2 列中具有值“变量”的最后一行。将列偏移 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

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

编辑

这是模板中行的示例 sheet

这就是 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

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

逻辑：

设置你的 input/output sheets.
在输出中找到要写入的最后一个单元格 sheet。必须检查之前有没有数据
如果没有数据，则复制 header 行。
复制范围。
确定要写入第 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

进行中

VBA 粘贴时合格单元格中的递增数字

VBA increment number in qualifying cell on paste

excel

vba

increment