VBA向左移動數據（每行需要移動4列，在需要保留的4列內可能有空白）

Question

我有一個包含一組問題的數據集。然而，部分數據已經被複制（4列）給受訪者。這些需要根據他們的標題合併成4列（答案1，答案2，答案3，答案4）。

Heres the example image

我已經試過這樣：

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 

，但它沒有遵守我需要

Answer 1

你不會是能夠做到的空白，在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