分成几行的VBA返回额外的数据

我是新来的VBA需要一些帮助的代码。

我有一个很大的电子表格，其中有数千行，每行unique_ID以及7到65个问题的答案。 我需要通过id拆分这些行，以便每行都有ID，问号和数值（问题答案）。

原始数据如下所示：

数据示例

我find了一个帮助我在这个页面上拆分行的VBA代码： 用一个标识符将一行拆分成几个

这是我正在使用的代码：

Sub NewLayout() For i = 2 To Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row For j = 0 To Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column If Cells(i, 13 + j) <> vbNullString Then intCount = intCount + 1 Cells(i, 1).Copy Destination:=Cells(intCount, 30) Cells(i, 2 + j).Copy Destination:=Cells(intCount, 31) Cells(i, 13 + j).Copy Destination:=Cells(intCount, 32) End If Next j Next i End Sub 

代码似乎工作，但我有输出的问题：它返回一些额外的数据，我不知道代码中的错误，以及如何摆脱它。

输出的例子被附上。

输出示例

任何帮助是极大的赞赏！

Answer 1

试试看，

 Sub NewLayout() with worksheets("sheet1") For i = 2 To .Cells(.rows.count, "A").end(xlup).Row For j = 0 To .Cells(i, 29).end(xltoleft).Column .cells(.rows.count, "AD").end(xlup).offset(1,0) = .cells(i, "A").value .cells(.rows.count, "AD").end(xlup).offset(0,1) = .cells(1, j).value .cells(.rows.count, "AD").end(xlup).offset(1,0) = .cells(i, j).value Next j Next i end with End Sub 

当您将值写入列AD：AF时，正在重新评估终止的j内嵌的For … Next。 您可能会考虑写入另一张工作表，或在您现有的数据下方，而不是在右侧。