重复剪切和粘贴 range/blocks/data（具有由特定字符串确定的不同行的范围）

Question

excelsheet中有一个由子集组成的数据集，垂直包含。每个子集的行长不同但列长相同。每个子集在“A”列中都有一个指标关键字“group1”。

我希望每个数据集彼此相邻水平对齐。

例如，假设范围 (A1:M3084) 中的整个数据由 x 行和 13 列的各种块组成。第一个数据块在 (A1:M124) 中，第二个数据块在 (A125:M250) 中，依此类推。我想剪切第二个块并将其粘贴到第一个块旁边，在中间留下一列 space（“N 列”），到 (O1:AA248)。然后，重复这个过程直到行尾，继续将下一个块（A241：M372）粘贴到第二个块旁边，到（AC1：AO372），依此类推...

为此，我需要找到包含“group1”的行号，它位于子集（左上角单元格）的开头，并使用 (row_number -1) 作为块大小, 并重复该过程。

我需要循环查找每个块大小，然后将块复制并粘贴到彼此旁边（水平）。

我一直在编写代码但没有成功（并且不确定如何循环这 2 个要求）。

谢谢。

Dim rowCount As Integer, colCount As Integer
Dim blockSize As Variant
Dim colOffset As Variant
Dim wordCount As Integer
  
'Find how many occurance of "group1"
wordCount = Application.WorksheetFunction.CountIf(ActiveSheet.Cells, "group1")
 
 'Find each block size by looping
        Dim FindRow As Variant
        Do Until FindRow Is Nothing
            FindRow = Columns("A").Find(What:="group1").Row  ' If text is "group1".
            If FindRow > 1 Then 'ignore the 1st block ("group1" inrow(1))
            blockSize = FindRow - 1   'row_number-1 = blocksize
          
        'count rows and columns with data
        rowCount = Range("A1").CurrentRegion.Rows.Count
        colCount = Range("A1").CurrentRegion.Columns.Count
                                     
       'move the 2nd block and paste it next to the 1st block, delete the block in origin, and continue until the last block
       For i = 1 To wordCount
        'column number to move
        colOffset = i * (colCount + 1)
                
        'move to next column block (@row1)  = data in the block @ orign
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(0, colOffset).Value2 = Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(blockSize * i, 0).Value2 'Value2 returns cerial number
        'clear the block in origin
        Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(blockSize * i, 0).ClearContents
   
        Loop
        Next i

End If

Answer 1

经过多次试验和错误，我可以弄清楚如何使用 vba 代码执行上述操作。唯一的缺点是我在移动的块下方从第 3 个块开始得到许多“#N/A”，这是我不想要的。我遇到的另一个问题是“FindRow”只在我首先想要它的时候才在最后看到第一行。

Dim rowCount As Integer, colCount As Integer, wordCount As Integer, firstFound As Integer
Dim FindRow As Range
Dim previousFound As Integer, nextFound As Integer, blockSize As Integer
Dim count As Integer, colOffset As Integer

    rowCount = Range("A1").CurrentRegion.Rows.count  'count row number
    colCount = Range("A1").CurrentRegion.Columns.count 'count column number
    wordCount = WorksheetFunction.CountIf(Range("A:A"), "*group: 1*") 'count occurance of a keyword in ""
    'MsgBox (wordCount) 'MsgBox for checking purpose
            
'Find row number of "group1" (-1 = blocksize)
With ActiveSheet.Range("A1:A" & rowCount)
Set FindRow = .Find(What:="group: 1", LookAt:=xlPart)
If Not FindRow Is Nothing Then
    firstFound = FindRow.Row   'get the first found row-> somehow, the first row "1" is skipped..
         
 
     count = 1
    Do Until count = wordCount
    'MsgBox (count) ..for checking
    previousFound = FindRow.Row
    'MsgBox (previousFound)..for checking
    Set FindRow = .FindNext(FindRow)
     
    
    nextFound = FindRow.Row
    If nextFound = 1 Then  'for the last block (nextFound returning to row1)
    nextFound = rowCount + 1
    Else
    'MsgBox (nextFound)..for checking
    End If
    
     blockSize = nextFound - previousFound
   ' MsgBox (blockSize)..for checking
   
     If FindRow Is Nothing Then Exit Do
    
     colOffset = count * (colCount + 1)
              
     'destination range =block range at the origin
    Range(Cells(1, 1), Cells(blockSize, colCount)).Offset(0, colOffset).Value2 = _
    Range(Cells(previousFound, 1), Cells(nextFound - 1, colCount)).Value2
    Range(Cells(previousFound, 1), Cells(nextFound - 1, colCount)).ClearContents
       
    count = count + 1 'count loops
       
    Loop
       
       
End If
End With

重复剪切和粘贴 range/blocks/data（具有由特定字符串确定的不同行的范围）

Cut and paste range/blocks/data repeatedly (ranges with varying rows determined by a specific string)

excel

vba

loops

range

paste