VBA将许多列转换为两个 – 我做错了什么？

嗨，我不是很熟悉vba。 但是我想出了以下内容，将一个包含多个列的电子表格变成两个。 示例显示了具有多个项目的名称。 我需要一行与每个项目的名称。

你可以看到每一行的长度可以改变。 我知道有多less行。 我已经做了以下脚本，但似乎无法得到它的工作。 请任何build议如何解决是非常有益的！

这是我的：

name1 | item1 | item2 | item3 | ITEM4

name2 | item5 | item3 | item19

这是我需要的：

name1 | ITEM1

name1 | ITEM2

name1 | 项目3

name1 | ITEM4

name2 | ITEM5

name2 | 项目3

name2 | item19

Sub moveToRows() Dim name As String, item as String, Dim r As Double, c As Double, r2 As Double, l As Double Sheets("Sheet1").Select r = 1 c = 1 r2 = 1 Do While r < 5000 ActiveSheet.Cells(r, c).Select name = ActiveCell.Value l = ActiveRow.Length Do While c <= l item = ActiveCell.Offset(0, c) Sheets("Sheet2").Range.Cells(r2, 1).Value = name Sheets("Sheet2").Range.Cells(r2, 2).Value = item c = c + 1 r2 = r2 + 1 Cells(r, c).Select Loop c = 1 r = r + 1 Loop End Sub 

Answer 1

按照build议，我能够用IsEmpty解决问题。 如variablesoRow中所示，更改了输出位置。

 Sub moveToRows() Dim name As String, item As String Dim r As Double, oRow As Double Range("A1").Select oRow = 5000 For r = 1 To ActiveCell.End(xlDown).Row Cells(r, 2).Select name = ActiveCell.Offset(0, -1).Value If IsEmpty(ActiveCell) Then Cells(oRow, 1).Value = name oRow = oRow + 1 End If Do Until IsEmpty(Selection) item = ActiveCell.Value Cells(oRow, 1).Value = name Cells(oRow, 2).Value = item ActiveCell.Offset(0, 1).Select oRow = oRow + 1 item = "" Loop Next End Sub