VBA向左移动数据（每行需要移动4列，在需要保留的4列内可能有空白）

我有一个包含一组问题的数据集。然而，部分数据已经被复制（4列）给受访者。这些需要根据他们的标题合并成4列（答案1，答案2，答案3，答案4）。VBA向左移动数据（每行需要移动4列，在需要保留的4列内可能有空白）

我已经试过这样：

Sub MoveLeft() 
Dim r As Long, rws As Long 

Application.ScreenUpdating = False 
    With ActiveSheet.UsedRange 
     rws = .Rows.Count 
     r = 1 
     On Error Resume Next 
     Do 
      .Rows(r).Resize(8000).SpecialCells(xlBlanks).Delete Shift:=xlToLeft 
      r = r + 8000 
     Loop While r <= rws 
     On Error GoTo 0 
    End With 
    Application.ScreenUpdating = True 
End Sub

，但它没有遵守我需要

来源

2017-06-15 Fiz

也许这会让过程更清晰 1）看每一行从A开始，$ F 2）沿该行 3）复制的第一个非空首先第一个非空，用三格到一起右它 4）在这四个单元F：？该行 5）我这样做了以后，自J – Fiz

你不会是能够做到的空白，在8000组行。每行都需要单独完成。

Sub qwerty() 
    Dim r As Long, pos As Long 
    With Worksheets("sheet2") 
     With Intersect(.Range("F:AC"), .UsedRange.Cells) 
      For r = 2 To .Rows.Count 
       .Cells(r, 1).Resize(1, 4).ClearContents 
       pos = .Cells(r, 1).End(xlToRight).Column - .Cells(r, 1).Column 
       If pos <= .Columns.Count Then 
        pos = Application.Floor(pos, 4) + 1 
        .Cells(r, 1).Resize(1, 4) = .Cells(r, pos).Resize(1, 4).Value2 
       End If 
      Next r 
     End With 
    End With 
End Sub

来源

2017-06-15 14:28:32 Jeeped

开始后删除多余的专栏中，我想我不会将它添加到代码正确，因为它不是具有所需的影响。当你说'放弃前5列，那不是我的问题。我应该在图表中添加前5列是完全正确的，并且在每个单元格中都有值。我的问题是，有一组4个答案需要左移每行。但有时候存在差距（如果答辩人没有回答四个问题中的一个）。我需要保持这些差距，以便答案在图片蓝色栏中的正确结构中。 – Fiz

您无法以8000行的组合来完成此操作。每行都需要单独完成。 – Jeeped

好的，谢谢！我从谷歌那里得到了这段代码，对此抱歉>。<。如果可以问，我将如何调整它来检查每一行？ – Fiz

VBA向左移动数据（每行需要移动4列，在需要保留的4列内可能有空白）

回答

相关问题