如何将许多列转换为excel中的一列，但保留每列的第一个单元格并在新行中重复？

Question

我有和excel文件看起来像这样：

我希望它像：

*逗号（，）表示数据水平位于不同的单元格中。

是否有任何vb宏或表达式来执行此操作？

Answer 1

如果所有行的列数相同，则可以使用INDEX，INT，COUNTA和MOD将其分解。

A栏：

=INDEX(Sheet1!$A$1:$D$2,1+INT((ROW()-1)/(COUNTA(Sheet1!$1:$1)-1)),1)

B栏：

=INDEX(Sheet1!$A$1:$D$2,1+INT((ROW()-1)/(COUNTA(Sheet1!$1:$1)-1)),2+MOD(ROW()-1,COUNTA(Sheet1!$1:$1)-1))

Sheet1!$A$1:$D$2是＆＃39;输入＆＃39;范围，Sheet1!$1:$1是该范围内的任何一行，包含完整的数据行。

INDEX可让您获取范围的特定行/列。我们的范围是Sheet1!$A$1:$D$2，两个公式的行相同：

1+INT((ROW()-1)/(COUNTA(Sheet1!$1:$1)-1)),

n 行为1，下一个 n 等为2，其中 n 是一行中的单元格数减去首发列（即每个性别的名称数量）

（INT删除数字的小数部分，因此INT(3/4)为INT(0.75)，即0。COUNTA只计算非空白单元格）

两者之间的区别是专栏。在A列中，我们只需要第一个列，因此列为1。在B列中，我们想要第一列之后的 x 项，其中 x A）每行计数1次，B）当我们从马累出来时重置为1对女性（或超越）

现在，MOD功能让我们可以非常简单地执行此操作：MOD(0, 3)为0，MOD(1, 3)为1，MOD(2, 3)为2，MOD(3, 3)为回到 0 。我们只需要将行计数开始为0（从行中减去1，然后将其添加回MOD之外）并从每行项目中删除第一列（从COUNTA中减去1） ，在MOD）

之外添加1

Answer 2

一个简单的解决方案是使用Split

Sub TransferIt()

Const SEP = ","

Dim rg As Range
Dim vdat As Variant
Dim lDat As Variant
Dim i As Long, j As Long
Dim col As Collection

    ' Assumption data is in column A, adjust accordingly
    Set rg = Range("A1:A4")
    vdat = WorksheetFunction.Transpose(rg)

    Set col = New Collection

    For i = LBound(vdat) To UBound(vdat)
        lDat = Split(vdat(i), SEP)
        For j = LBound(lDat) + 1 To UBound(lDat)
            ' first field always contains female or male
            col.Add lDat(LBound(lDat)) & SEP & lDat(j)
        Next j
    Next i

    vdat = collectionToArray(col)

    ' Write data into column B
    Range("B1").Resize(UBound(vdat) + 1) = WorksheetFunction.Transpose(vdat)

End Sub

' Source: http://www.iwebthereforeiam.com/iwebthereforeiam/2004/06/excel-vba-code-to-convert-coll.html
Function collectionToArray(c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim i As Integer
    For i = 1 To c.Count
        a(i - 1) = c.Item(i)
    Next
    collectionToArray = a
End Function

Answer 3

在：

后：

代码：

Sub settupp()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
s1.Activate
n = Cells(Rows.Count, 1).End(xlUp).Row
k = 1
For i = 1 To n
namee = Cells(i, 1).Value
For j = 2 To 4
numberr = Cells(i, j).Value
s2.Cells(k, 1) = namee
s2.Cells(k, 2) = numberr
k = k + 1
Next
Next
End Sub