如何在Excel中的同一列中复制N次行?

How to copy a row N number of times in the same column in Excel?

我们无法创建一个公式来以相同的顺序复制一列的 200 行并将其多次粘贴到同一列和相同的顺序中。

示例:列 A1:A200 具有特定顺序的名称,我们希望在同一列中重复相同的顺序 3000 次。

不用手动拖动的方法是什么?

使用 Office 365,您可以按如下方式将其放入 LET:

=LET( a, A1:A200, mBy, 3000,
       r, ROWS( a ),
       s, r * mBy,
       INDEX( a, MOD(SEQUENCE( s,,0 ),r) + 1 ) )

其中 a 是名称列,mBy 是倍数 (3000)。

如果你想简化它:

= INDEX( A1:A200, MOD(SEQUENCE( ROWS(A1:A200) * 3000,,0 ),ROWS(A1:A200)) + 1 )

Multi-Stack 一个垂直范围

Sub VMultiStackTEST()

    Const SourceRangeAddress As String = "A1:A200"
    Const DestinationFirstCellAddress As String = "A1"
    Const StackCount As Long = 3000

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim srg As Range: Set srg = ws.Range(SourceRangeAddress)
    Dim dfCell As Range: Set dfCell = ws.Range(DestinationFirstCellAddress)
    
    VMultiStack srg, dfCell, StackCount
    
    ' or (instead) just e.g.:
    'VMultiStack Range("A1:A200"), Range("A1"), 3000

End Sub

Sub VMultiStack( _
        ByVal SourceRange As Range, _
        ByVal DestinationFirstCell As Range, _
        Optional ByVal StackCount As Long = 1)
    Const ProcName As String = "VMultiStack"
    On Error GoTo ClearError
 
    Dim IsSuccess As Boolean
 
    Dim sData As Variant
    Dim srCount As Long
    Dim cCount As Long
    Dim sAddress As String
    
    With SourceRange.Areas(1)
        sAddress = .Address(0, 0)
        srCount = .Rows.Count
        cCount = .Columns.Count
        If srCount + cCount = 2 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
        Else
            sData = .Value
        End If
    End With
    
    Dim dData As Variant: ReDim dData(1 To srCount * StackCount, 1 To cCount)
    
    Dim n As Long
    Dim sr As Long
    Dim dr As Long
    Dim c As Long
    
    For n = 1 To StackCount
        For sr = 1 To srCount
            dr = dr + 1
            For c = 1 To cCount
                dData(dr, c) = sData(sr, c)
            Next c
        Next sr
    Next n
    
    Dim dAddress As String
    
    With DestinationFirstCell.Resize(, cCount)
        With .Resize(dr)
            .Value = dData
            dAddress = .Address(0, 0)
        End With
        .Resize(.Worksheet.Rows.Count - .Row - dr + 1).Offset(dr).Clear
    End With
    
    IsSuccess = True
    
ProcExit:
    If IsSuccess Then
        MsgBox "Stacked '" & sAddress & "' " & StackCount & " times to '" _
            & dAddress & "'.", _
            vbInformation, ProcName
    Else
        If Len(sAddress) > 0 Then
            MsgBox "Could not stack '" & sAddress & "' " & StackCount _
                & " times. No action taken.", _
                vbExclamation, ProcName
        Else
            MsgBox "The program failed.", vbCritical, ProcName
        End If
    End If

    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub