Excel VBA 反复剪切和粘贴愤怒

Question

在使用 VBA 并尝试反复剪切和复制范围方面，我完全是个新手。我一直在搜索和尝试我的代码，但一无所获...

例如，假设范围 (A1:M1084) 中的全部数据由 124 行 13 列的块组成。所以第一个块在 (A1:M124) 中。第二个数据块当前在 (A125:M248) 中，想将其剪切并粘贴到第一个块旁边，中间留一列 space (N)，到 (O1:AA248)。然后，重复该过程直到行尾（这次是 1084，但可以是任何其他数字），继续将下一个块 (A249: M372) 粘贴到第二个块旁边，到 (AC1:AO248)，依此类推...

如果有人能帮忙，不胜感激！

Answer 1

尝试这样的事情。

Sub MoveBlocks()

    Dim rowCount As Integer, colCount As Integer
    Dim inRow As Integer
    Dim blockSize As Integer
    Dim colOffset As Integer

    blockSize = 124
    rowCount = Range("A1").CurrentRegion.Rows.Count
    colCount = Range("A1").CurrentRegion.Columns.Count

    For inRow = blockSize + 1 To rowCount Step blockSize
        colOffset = Int(inRow / blockSize) * (colCount + 1)
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(0, colOffset).Value2 = Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(inRow - 1, 0).Value2
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(inRow - 1, 0).ClearContents
    Next inRow
End Sub

Answer 2

毕竟，我自己经历了那么多试错，也得到了答案。发布如果它可能有任何用处。另外，如果有任何其他更高效的代码，将很高兴！

Sub Cutrange()

  Dim i As Long
  Dim Lrow As Long
  Lrow = Cells(Rows.Count, 1).End(xlUp).Row

  Dim oRange As Range, dRange As Range
  Set oRange = Range(Cells(1, 1), Cells(124, 14))
  Set dRange = Cells(1, 1)

  For i = 1 To Lrow 
    oRange.Offset(124 * i).Cut Destination:=dRange.Offset(, 14 * i)
  Next i
End Sub

Excel VBA 反复剪切和粘贴愤怒

Excel VBA cut and paste rage repeatedly

excel

vba

loops

range

paste