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

Question

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

我有一个大型电子表格，其中包含数千行，每行具有唯一ID，并且从7到65个问题的答案。 我需要按ID拆分此行，以便每行都有ID，问题编号和数字值（问题答案）。

原始数据如下所示：

资料范例

我找到了一个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

在嵌套的For ...中重新评估终止的j 。接下来，您正在将值写入AD：AF列。 您可能会考虑写入另一个工作表或在现有数据下方而不是在右侧。