我們無法創建一個公式，該公式將以相同的順序復制一列的 200 行并以相同的順序將其多次粘貼到同一列中。
示例：列 A1:A200 具有特定順序的名稱，我們希望在同一列中重復相同的順序 3000 次。
沒有手動拖動的方法是什么？
uj5u.com熱心網友回復：
垂直堆疊一個范圍
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
uj5u.com熱心網友回復：
使用 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 )
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/483026.html
下一篇：帶有必填空格的正則運算式電話號碼