如何将其压缩为For循环?

Question

提前感谢您的帮助。我不是伟大的在VBA的任何手段，我猜必须有一种方法来节省时间/精力编写代码。总之，我正在尝试获取Sheet1。要在Sheet2上打印的单元格(2,1)。单元格(i, 1)，其中i = 2到21，然后移动到工作表1中的下一行。所以，它会对Sheet1做同样的事情。要打印到Sheet2的单元格(3,1)。单元格(i, 1)，其中i = 22到41。下面是我的工作代码，但我需要这样做数千次。有什么方法可以使这个代码更健壮吗?

Sub VIN_Decode()
For i = 2 To 21
Sheet2.Cells(i, 1) = Sheet1.Cells(2, 1)
Next
For i = 22 To 41
Sheet2.Cells(i, 1) = Sheet1.Cells(3, 1)
Next
For i = 42 To 61
Sheet2.Cells(i, 1) = Sheet1.Cells(4, 1)
Next
For i = 62 To 81
Sheet2.Cells(i, 1) = Sheet1.Cells(5, 1)
Next
For i = 82 To 101
Sheet2.Cells(i, 1) = Sheet1.Cells(6, 1)
Next
End Sub

Answer 1

使用步进调整大小:

Sub VIN_Decode()
For i = 2 To 82 Step 20
Sheet2.Cells(i, 1).Resize(20, 1).Value = Sheet1.Cells((i - 2) / 20 + 2, 1).Value
Next
End Sub

Answer 2

最基本的重写代码是:

Sub VIN_Decode()
For j = 0 To 4
For i = 2 To 21
Sheet2.Cells(20 * j + i, 1) = Sheet1.Cells(j + 2, 1)
Next
Next
End Sub

Answer 3

在数组中获取Sheet1中的源值
将目标范围的高度设置为常量
然后循环源数组

Sub VIN_Decode()
Const kHeight As Byte = 20
Dim aSource As Variant
Dim lRow As Long
Dim vItem As Variant
aSource = Sheet1.Cells(2, 1).Resize(5)
With Sheet2
lRow = 2    'Initial Row
For Each vItem In aSource
Debug.Print vItem
.Cells(lRow, 1).Resize(kHeight).Value = vItem
lRow = lRow + kHeight
Next
End With

End Sub

或者你可以用这个公式:

= IFERROR( INDEX( Sheet1!A:A, LOOKUP(ROW(), {2,2;22,3;42,4;62,5;82,6;102,""}) ), TEXT(,) )

Answer 4

用堆叠的单元格值填充堆叠的区域

• 调整(播放)常数部分的值

Option Explicit
Sub FillStackedRangesWithStackedCellValuesTEST()
Const dfrgAddress As String = "A2:A21"
Const sfCellAddress As String = "A2"
Const StacksCount As Long = 5

Dim sfCell As Range: Set sfCell = Sheet1.Range(sfCellAddress)
Dim dfrg As Range: Set dfrg = Sheet2.Range(dfrgAddress)

FillStackedRangesWithStackedCellValues dfrg, sfCell, StacksCount

End Sub
Sub FillStackedRangesWithStackedCellValues( _
ByVal FirstRange As Range, _
ByVal FirstCell As Range, _
ByVal StacksCount As Long)
Const ProcName As String = "FillStackedRangesWithStackedCellValues"
On Error GoTo ClearError

Dim sCell As Range: Set sCell = FirstCell.Cells(1) ' ensure one cell
Dim drg As Range: Set drg = FirstRange
Dim drCount As Long: drCount = drg.Rows.Count

Dim Stack As Long

For Stack = 1 To StacksCount
drg.Value = sCell.Value
Set drg = drg.Offset(drCount)
Set sCell = sCell.Offset(1)
Next Stack

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

对俏皮话

Sub FillStackedRangesWithStackedCellValuesTEST2()
FillStackedRangesWithStackedCellValues _
FirstRange:=Sheet2.Range("A2:A21"), _
FirstCell:=Sheet1.Range("A2"), _
StacksCount:=5

End Sub
Sub FillStackedRangesWithStackedCellValuesTEST3()
FillStackedRangesWithStackedCellValues _
Sheet2.Range("A2:A21"), Sheet1.Range("A2"), 5

End Sub