VBA Excel循环，带扩展单元格范围的偏移量_Excel_Vba

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

excel vba

VBA Excel循环，带扩展单元格范围的偏移量,excel,vba,Excel,Vba,早上好我已经为这个范围做了一个循环，它是从一张纸复制到另一张纸的。但是，我没有办法缩减代码，如下所示： Sub sunrise() Dim i As Single With Worksheets("7") .UsedRange.Clear .Range("a1").Value = "Latitude" .Range("b1").Value = "-18" .Range("c1&quo

早上好

我已经为这个范围做了一个循环，它是从一张纸复制到另一张纸的。但是，我没有办法缩减代码，如下所示：

 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

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

端接头

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

但是在我的事件中，

显示为单个值，并分别为上面定义的特定行分配

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

 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

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

有没有办法减少这个代码？

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

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

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

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

您最后的建议在右行，只需在

偏移量

后添加

调整大小

。切勿将浮点类型（例如双精度和单精度）用作循环计数器。由于舍入错误，循环可能会比您想象的更早或更晚终止，在您能够找出导致错误的原因之前，您将挠头一个月。这是我的教授给我的建议，我一直记得。你的最后一个建议是正确的，只需要在

偏移量之后添加调整大小
。千万不要使用浮点类型（例如双精度和单精度）作为循环计数器。由于舍入错误，循环可能会比您想象的更早或更晚终止，在您能够找出导致错误的原因之前，您将挠头一个月。这是我的教授给我的建议，我一直记得。是的，但我需要两张代码表。一个是“1.GENERAL”，另一个是“7”。@MKR：这只是一个例子。但是，好的，我会修改你两张表的代码。。。改编。@MKR:您是否有时间测试上述代码？它能按您的需要工作吗？@MKR:但是您需要在代码中使用迭代来完成什么？您只需要在第一个空行复制“E742:Y742”范围一次，还是需要填充更多的行并增加复制的范围（“E743:Y743”、“E744:Y744”、“E745:Y745”等…）？我将在下次测试您的代码（我相信在2小时内）。现在，我使用了@SJR解决方案，它可以正常工作。我在第一行有以下列-18，-17-16。。。最高可达+4。在下一行中，我想填充相应的值，如图（Sheet2）所示。是的，但我需要代码中的两张表。一个是“1.GENERAL”，另一个是“7”。@MKR：这只是一个例子。但是，好的，我会修改你两张表的代码。。。改编。@MKR:您是否有时间测试上述代码？它能按您的需要工作吗？@MKR:但是您需要在代码中使用迭代来完成什么？您只需要在第一个空行复制“E742:Y742”范围一次，还是需要填充更多的行并增加复制的范围（“E743:Y743”、“E744:Y744”、“E745:Y745”等…）？我将在下次测试您的代码（我相信在2小时内）。现在，我使用了@SJR解决方案，它可以正常工作。我在第一行有以下列-18，-17-16。。。最高可达+4。接下来在下一行中，我要填充相应的值，如您在图像（表2）中看到的。