从4×2表切割和粘贴成一行

我有一个Excel电子表格，可以解答考试的问题。 它被设置为一系列4×2块。 每个块在第一列中有4个多项select答案，然后右边的列中有0或1表示正确或不正确。

我想创build一个macros，把第二，第三和第四个答案和相应的0/1单元格粘贴起来，以便它们结束到块中第一个答案的右侧。 我有这个macros到目前为止，它成功地编辑了第一个答案和正确性指标列：

Range("A2:B2").Select Selection.Cut Range("C1").Select ActiveSheet.Paste Range("A3:B3").Select Selection.Cut Range("E1").Select ActiveSheet.Paste Range("A4:B4").Select Selection.Cut Range("G1").Select ActiveSheet.Paste 

我怎样才能改变它，使它会做2,3,4,6,7,8,10,11,12等细胞，但跳过1，5，9等？

谢谢！

Answer 1

鉴于以下内容的input：

使用代码：

 Sub QReform() Dim CurRow As Long, LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For CurRow = LastRow To 1 Step -1 If ((CurRow - 1) / 5) - ((CurRow - 1) \ 5) = 0 Then Cells(CurRow, 2).Value = Cells(CurRow, 1).Offset(1, 0).Value Cells(CurRow, 3).Value = Cells(CurRow, 1).Offset(1, 1).Value Cells(CurRow, 4).Value = Cells(CurRow, 1).Offset(2, 0).Value Cells(CurRow, 5).Value = Cells(CurRow, 1).Offset(2, 1).Value Cells(CurRow, 6).Value = Cells(CurRow, 1).Offset(3, 0).Value Cells(CurRow, 7).Value = Cells(CurRow, 1).Offset(3, 1).Value Cells(CurRow, 8).Value = Cells(CurRow, 1).Offset(4, 0).Value Cells(CurRow, 9).Value = Cells(CurRow, 1).Offset(4, 1).Value Cells(CurRow, 1).Offset(4, 0).EntireRow.Delete xlShiftUp Cells(CurRow, 1).Offset(3, 0).EntireRow.Delete xlShiftUp Cells(CurRow, 1).Offset(2, 0).EntireRow.Delete xlShiftUp Cells(CurRow, 1).Offset(1, 0).EntireRow.Delete xlShiftUp End If Next CurRow End Sub 

会给你这个：

Answer 2

我最终将列移动到一个文本编辑器，并使用正则expression式来完成这项工作，因为这是一个更简单的方法。 我search了4行的块，并在适当的位置用标签replace了返回，因此它可以放在一行上，并轻松地返回到Excel。