带有偏移的 VBA Excel 循环，用于扩展单元格范围

Question

早上好，

我已经为范围创建了循环，它从一张纸复制到另一张纸。但是，我没有解决方案来精简我的代码，如下所示：

 Sub sunrise()
Dim i As Single
With Worksheets("7")
.UsedRange.Clear
.Range("a1").Value = "Latitude"
.Range("b1").Value = "-18"
.Range("c1").Value = "-17"
.Range("d1").Value = "-16"
.Range("e1").Value = "-15"
.Range("f1").Value = "-14"
.Range("g1").Value = "-13"
.Range("h1").Value = "-12"
.Range("i1").Value = "-11"
.Range("j1").Value = "-10"
.Range("k1").Value = "-9"
.Range("l1").Value = "-8"
.Range("m1").Value = "-7"
.Range("n1").Value = "-6"
.Range("o1").Value = "-5"
.Range("p1").Value = "-4"
.Range("q1").Value = "-3"
.Range("r1").Value = "-2"
.Range("s1").Value = "-1"
.Range("t1").Value = "-0.85"
.Range("u1").Value = "0.6"
.Range("v1").Value = "1.7"
.Range("w1").Value = "2.76"
.Range("x1").Value = "3.84"

 For i = 48 To 60 Step 0.25
    Worksheets("1. GENERAL").Range("A2").Value = i '* (-1)
    With .Cells(Rows.Count, 1).End(xlUp)
    .Offset(1, 0).Value = i
    .Offset(1, 1).Value = Worksheets("1. GENERAL").Range("E742").Value
    .Offset(1, 2).Value = Worksheets("1. GENERAL").Range("F742").Value
    .Offset(1, 3).Value = Worksheets("1. GENERAL").Range("G742").Value
    .Offset(1, 4).Value = Worksheets("1. GENERAL").Range("H742").Value
    .Offset(1, 5).Value = Worksheets("1. GENERAL").Range("I742").Value
    .Offset(1, 6).Value = Worksheets("1. GENERAL").Range("J742").Value
    .Offset(1, 7).Value = Worksheets("1. GENERAL").Range("K742").Value
    .Offset(1, 8).Value = Worksheets("1. GENERAL").Range("L742").Value
    .Offset(1, 9).Value = Worksheets("1. GENERAL").Range("M742").Value
    .Offset(1, 10).Value = Worksheets("1. GENERAL").Range("N742").Value
    .Offset(1, 11).Value = Worksheets("1. GENERAL").Range("O742").Value
    .Offset(1, 12).Value = Worksheets("1. GENERAL").Range("P742").Value
    .Offset(1, 13).Value = Worksheets("1. GENERAL").Range("Q742").Value
    .Offset(1, 14).Value = Worksheets("1. GENERAL").Range("R742").Value
    .Offset(1, 15).Value = Worksheets("1. GENERAL").Range("S742").Value
    .Offset(1, 16).Value = Worksheets("1. GENERAL").Range("T742").Value
    .Offset(1, 17).Value = Worksheets("1. GENERAL").Range("U742").Value
    .Offset(1, 18).Value = Worksheets("1. GENERAL").Range("V742").Value
    .Offset(1, 19).Value = Worksheets("1. GENERAL").Range("W742").Value
    .Offset(1, 20).Value = Worksheets("1. GENERAL").Range("X742").Value
    .Offset(1, 21).Value = Worksheets("1. GENERAL").Range("Y742").Value
    .Offset(1, 22).Value = Worksheets("1. GENERAL").Range("Z742").Value
    .Offset(1, 23).Value = Worksheets("1. GENERAL").Range("AA742").Value
    End With
  Next I
 End With

结束子

我希望我可以在数组中分配这些值，如下例所示：

Excel VBA - Pass a Row of Cell Values to an Array and then Paste that Array to a Relative Reference of Cells

但在我的情况下，i 显示为单个值，并为上面定义的特定行单独分配。

我也在考虑这样的解决方案：

   .Offset(1, 1).Value = Worksheets("1. GENERAL").Range("E742:AA742").Value

有什么办法可以减少这段代码？

Answer 1

请尝试下一种方法。它会将范围复制到最后一个空行（针对 A:A 计算），从 B 列开始：

Sub testCopyArray()
 Dim sh7 As Worksheet, shG As Worksheet, lastRow As Long, rng As Range
 
 Set sh = Worksheets("7")
 Set shG = Worksheets("1. GENERAL")
  lastRow = sh.Cells(Rows.count, 1).End(xlUp)
  Set rng = sh.Range("A" & lastRow + 1)

  rng.Offset(1).Value = 1
  sh.Range(rng.Offset(1, 1), rng.Offset(1, 21)).Value = shG.Range("E742:Y742").Value
  'or:
  rng.Offset(1,1).Resize(,shG.Range("E742:Y742").columns).value = shG.Range("E742:Y742").Value
End Sub