在Excel中将行转换为堆栈列

我有以下forms的数据集:(每个逗号表示Excel中的一个单独的列）

Name1，Number11，Number12，Number13
Name2，Number21
Name3，Number31，Number32

一个特定的名字具有不同的数字属性，这些数字属性存在于上面显示的格式的相邻列中。 没有固定数量的与特定名称相关联的属性，如Name1具有3，Name2具有1等等。 我想要在两列输出为

Name1，Number11
Name1，Number12
Name1，Number13
Name2，Number21
Name3，Number31
Name3，Number32

到目前为止，通过互联网上的帮助，我已经到了一个我认为更接近解决scheme的地步，但我不相信这是最佳的。 首先，我发现哪个名称的属性数量最多，然后用特殊字符（$）填充所有其他名称的空单元格，以便所有名称的列数都相同。 数据看起来像这样操作之后：

Name1，Number11，Number12，Number13
Name2，Number21，$，$
Name3，Number31，Number32，$

然后我使用下面的代码:(从互联网上获得）

Sub ConvertRangeToColumn() Dim Range1 As Range, Range2 As Range, Rng As Range Dim rowIndex As Integer Set Range1 = Application.Selection Set Range1 = Application.InputBox("Source Ranges:", Range1.Address, Type:=8) Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8) rowIndex = 0 Application.ScreenUpdating = False For Each Rng In Range1.Rows Rng.Copy Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True rowIndex = rowIndex + Rng.Columns.Count Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub 

我在一个列中获得了所有的值。 然后我筛选$值，并删除它们。 所以现在数据看起来像：

名1
Number11
Number12
Number13
名称2
Number21
NAME3
Number31
Number32

我没有能够超越这个，因此这个职位。 你能帮助从这里到达最后的产出，还是完全采用更好的方法，最好是我不必四处填充空单元？ 谢谢！

Answer 1

如果我们从Sheet3开始：

并运行这个macros：

 Sub ReOrganize() Dim s1 As Worksheet, s2 As Worksheet, i As Long, j As Long, K As Long Dim v1 As Variant, v2 As Variant, N1 As Long, N2 As Long Set s1 = Sheets("Sheet3") Set s2 = Sheets("Sheet4") K = 1 N1 = s1.Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To N1 v1 = s1.Cells(i, 1).Value N2 = s1.Cells(i, Columns.Count).End(xlToLeft).Column For j = 2 To N2 s2.Cells(K, 1).Value = v1 s2.Cells(K, 2).Value = s1.Cells(i, j) K = K + 1 Next j Next i End Sub 

我们将以Sheet4结束

Answer 2

 Sub getOut() Dim rngIn As Range Dim rngOut As Range Dim intRowC As Long Dim intColC As Long Dim strVal1 As String Dim strVal2 As String Set rngOut = Sheet1.Range("K1") '<<---Data Set rngIn = Sheet1.Range("A1").CurrentRegion '<<----Output For intRowC = 1 To rngIn.Rows.Count For intColC = 1 To rngIn.Rows(intRowC).Cells.Count strVal1 = rngIn.Cells(intRowC, 1).Value strVal2 = rngIn.Cells(intRowC, intColC).Value If intColC > 1 Then If strVal2 = vbNullString Then Exit For rngOut.Value = strVal1 rngOut.Offset(, 1).Value = strVal2 Set rngOut = rngOut.Offset(1) End If Next intColC Next intRowC ClearMemory: Set rngIn = Nothing Set rngOut = Nothing intRowC = Empty intColC = Empty strVal1 = vbNullString strVal2 = vbNullString End Sub 

希望这将解决您的担忧… 🙂