对于下一个循环（初学者）

Question

我想将灰色单元格复制到行，但仅复制最后一列灰色单元格。

Answer 1

不需要嵌套循环

Sub Test()
Dim r As Integer, c As Integer

r = 3
For c = 3 To 21 Step 3
    Cells(r, 1) = Cells(1, c)
    r = r + 1
Next c
End Sub

Answer 2

您是如此亲密：）

Option Explicit

Sub istebu()

Dim x As Long
Dim i As Long

For i = 3 To 10 'Loop in row from 3 to 10
    For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
        Cells(i, 1) = Cells(1, x) 'Copy values.
        i = i + 1 'Add one row each time, so we don't overwrite previously row
    Next x
Next i
End Sub

---

替代：

它可以缩短，因为我们不需要遍历行。我们只需要添加它们。因此，我们将i设置为应该粘贴数据的开始行。

Sub istebu()

Dim x As Long
Dim i As Long

i = 3 'Set first row number you want to loop from.

For x = 3 To 21 Step 3 'Loop header row, from 3 to 21, jump 3
        Cells(i, 1) = Cells(1, x) 'Copy values.
        i = i + 1 'Add one row each time, so we don't overwrite previously row
Next x
End Sub

Answer 3

还有一种完全替代循环的方法。

Range("C1,F1,I1,L1,O1,R1,U1").Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True

但是，如果您真的很陷入循环，请使用一个来构建联合。

dim i as long, rng as range

for 3 to 21 step 3
    if rng is nothing then
        set rng = cells(1, i)
    else
        set rng = union(rng, cells(1, i))
    end if
next i

rng.Copy
Range("A3").PasteSpecial Paste:=xlPasteValues, Transpose:=True