VBA Excel重复复制和粘贴多个值

Question

我在VBA excel中遇到多个值问题，我想复制并粘贴到另一个工作簿（或另一个工作表中，但不一定在本主题中）。

关键是，我得到的D列和E列的值的范围从第1到366行（D1：D366和E1：E366），我必须在单元格A5（D列）和B5 9列E）中进行切换。 这很简单。 但是，当我添加另一个命令来复制和粘贴值时，尽管复制的单元格的范围保持不变并且具有粘贴数据的单元格的范围发生了变化（每步增加30个值），但我不知道如何使此过程更快。 我已经做了5个可重复的组合，但是我还需要361个其他组合。

是否为该操作提供了一些更方便的代码？

我的代码在这里可用：

Sub jan01()
Range("A5") = ("=D1")
Range("B5") = ("=E1")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A1:AP27").PasteSpecial xlPasteValues
End Sub

Sub jan02()
Range("A5") = ("=D2")
Range("B5") = ("=E2")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A31:AP57").PasteSpecial xlPasteValues
End Sub

Sub jan03()
Range("A5") = ("=D3")
Range("B5") = ("=E3")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A61:AP87").PasteSpecial xlPasteValues
End Sub

Sub jan04()
Range("A5") = ("=D4")
Range("B5") = ("=E4")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A91:AP117").PasteSpecial xlPasteValues
End Sub

Sub jan05()
Range("A5") = ("=D5")
Range("B5") = ("=E5")
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A121:AP147").PasteSpecial xlPasteValues
End Sub

根据上面的描述，单元格A5和B5的值一一更改。 对于每种简单情况，表13的范围每隔30个单元向下增加。 最终，我希望一个接一个地复制所有数据，而不会像附加的图像那样重叠（放大以显示通用目的）。 在此处输入图像描述为了将所有图像组合在一起，我使用了一个宏：

Sub january()
Call jan01
Call jan02
Call jan03
Call jan04
Call jan05
End Sub

无论如何，这项工作看起来很乏味，我相信，这是解决它的更快解决方案？ 有人遇到过这样的问题吗？

谢谢

Answer 1

我不是100％肯定我会遵循您要在此处实现的目标，但是我写的代码似乎与您现有的代码相同，但使用的是一个例程，而不是六个例程：

Sub january()
    Dim i As Integer
    i = 1
    While i < 6
        Range("A5") = ("=D" + CStr(i))
        Range("B5") = ("=E" + CStr(i))
        Sheets("11_POLAND").Range("AJ60:BY86").Copy
        Sheets("13").Range("A" + CStr(i + ((i - 1) * 30)) + ":AP" + CStr(i + ((i - 1) * 30) + 26)).PasteSpecial xlPasteValues
        i = i + 1
    Wend
End Sub

以此为起点，我想您可以将i < 6更改为i < 367吗？

Answer 2

这是您使用For循环编写的代码。 我仍然有上面提出的问题和与您正在使用的工作表有关的假设。 这类似于给出的答案，除了使用变量使阅读代码更容易以及使用Offset（再次使代码易于阅读）。

Option Explicit
Public Sub CopyRanges()
    Application.ScreenUpdating = False
    Dim sheetFrom As Worksheet, sheetTo As Worksheet, i As Long
    Set sheetFrom = ThisWorkbook.Worksheets("11_POLAND")
    Set sheetTo = ThisWorkbook.Worksheets("13")
    Dim aRange As Range: Set aRange = sheetFrom.Range("A5")
    Dim bRange As Range: Set bRange = sheetFrom.Range("B5")

    With sheetFrom
        For i = 1 To 5 '<== 5 for up to jan05
            aRange = ("=D" & i)
            bRange = ("=E" & i)
            .Range("AJ60:BY86").Copy
            sheetTo.Range("A1:AP27").Offset((i - 1) * 30, 0).PasteSpecial xlPasteValues
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Answer 3

谢谢你们的帮助。

我输入了以下代码：

Sub january()
Dim i As Integer
For i = 1 To 31
Sheets("1_GENERAL").Range("A5") = ("=D" + CStr(i))
Sheets("1_GENERAL").Range("B5") = ("=E" + CStr(i))
Sheets("11_POLAND").Range("AJ60:BY86").Copy
Sheets("13").Range("A" + CStr(i + ((i - 1) * 29)) + ":AP" + CStr(i + ((i - 1) * 29))).PasteSpecial xlPasteValues
Next i
End Sub

其中：-“ i”表示特定行。 如果是一月，则为1到31（一年中的1-31天）-“ 29”表示每个随后的顶行将粘贴在下面的大约29行中。 -D列和E列包含限制为某些“ i”值的值。

希望对所有在VBA Excel中处理大数据的人有所帮助。