美文网首页
利用VBA实现跨行复制和序号自增

利用VBA实现跨行复制和序号自增

作者: Noza_ea8f | 来源:发表于2024-06-02 15:29 被阅读0次
image.png

初始表只有这样一个,目标表是这样


image.png

废话不多说,直接上代码:
其实只要描述清楚,AI就可以给你答案:

我的描述:

我有一个excel表格,表头有合并,下面有序号,序号从1开始,下面只有一行,然后复制这个表,隔三行进行粘贴,序号自增为2,再重复这个过程,直到复制50份,怎么快速的实现这个表格,需要更新的序号初始位置在A5单元格,需要复制的表格从A1到F5

AI返回结果:

Sub CopyTablesWithIncrementalSerialNumbers()
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim serialCell As Range
    Dim i As Long
    Dim offsetRow As Long

    ' 设置源范围,即需要复制的表格区域
    Set sourceRange = ThisWorkbook.Sheets("Sheet1").Range("A1:F5") ' 假设表格在Sheet1上

    ' 设置序号单元格
    Set serialCell = ThisWorkbook.Sheets("Sheet1").Range("A5")

    ' 设置目标区域的初始行偏移量,每张表之间间隔三行
    offsetRow = 7 ' 包括表本身的一行和下面的三行

    ' 循环复制50次
    For i = 1 To 50
        ' 计算目标区域的起始位置
        Set targetRange = ThisWorkbook.Sheets("Sheet1").Cells(sourceRange.Row + offsetRow * i, sourceRange.Column)

        ' 复制源范围到目标位置
        sourceRange.Copy Destination:=targetRange

        ' 更新序号
        serialCell.Offset(offsetRow * i).Value = i + 1
    Next i

    ' 清除剪贴板
    Application.CutCopyMode = False
End Sub

完美!!!

让AI重新翻译这段代码,并加注释

Sub CopyTablesWithIncrementalSerialNumbers()
    ' 定义变量
    Dim sourceRange As Range      ' 源范围,即需要复制的表格区域
    Dim targetRange As Range    ' 目标范围,复制后放置的区域
    Dim serialCell As Range    ' 序号单元格,存放序号的单元格
    Dim i As Long           ' 循环计数器
    Dim offsetRow As Long      ' 表格间偏移行数,每次复制后空出的行数
    
    ' 设置源范围,假设表格在Sheet1的A1到F5
    Set sourceRange = ThisWorkbook.Sheets("Sheet1").Range("A1:F5")
    
    ' 设置序号单元格,即初始序号所在的单元格
    Set serialCell = ThisWorkbook.Sheets("Sheet1").Range("A5")
    
    ' 设置每次复制后表格间的行数偏移量,包括当前表格占用的行和其下三行空行
    offsetRow = 7
    
    ' 循环复制操作,总共复制50次
    For i = 1 To 5
        ' 计算目标区域的起始位置,基于偏移量和当前循环次数
        Set targetRange = ThisWorkbook.Sheets("Sheet1").Cells(sourceRange.Row + offsetRow * i, sourceRange.Column)
        
        ' 将源范围的内容复制到计算出的目标位置
        sourceRange.Copy Destination:=targetRange
        
        ' 更新序号,每次复制后在原始序号基础上加1并根据偏移量定位到正确行
        serialCell.Offset(offsetRow * i).Value = i + 1
    Next i
    
    ' 清除剪贴板状态,避免影响后续操作
    Application.CutCopyMode = False
End Sub

上面的次数可以调整,50次我改为了5,由于VBA运行速度较慢,所以为了测试我只运行5次;

相关文章

网友评论

      本文标题:利用VBA实现跨行复制和序号自增

      本文链接:https://www.haomeiwen.com/subject/sjrsqjtx.html