Question

我有以下形式的数据集:(每个逗号表示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

到目前为止，通过互联网上的帮助，我已经到了一个点，我认为更接近解决方案，但我不相信这是最佳的。首先，我找出了哪个名称具有最大属性数，然后我用所有其他名称填充了带有特殊字符（$）的空单元格，以便所有名称在右侧填充相同数量的列。操作后数据如下所示：

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

我在一列中获得了所有值。然后我过滤了$ values并删除了它们。所以现在数据看起来像：

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

我无法超越这个，因此这篇文章。你能帮助从这里到最终输出，或者使用一种更好的方法，最好是我不需要四处填充空单元格吗？谢谢！

Answer 1

如果我们在 Sheet3 中开始：

enter image description here

并运行此宏：

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

中结束此操作

enter image description here

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

希望这能解决您的问题... :)

在Excel中将行转换为堆叠列

2 个答案: