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

时间:2018-03-05 12:08:16

标签: excel excel-vba excel-formula excel-2016 vba

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

Input, {Male|John|Mike|George}{Female|Ann|Joan|Jane}

我希望它像:

Output, {Male|John}{Male|Mike}{Male|George}{Female|Ann}{Female|Joan}{Female|Jane}

*逗号(,)表示数据水平位于不同的单元格中。

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

3 个答案:

答案 0 :(得分:3)

如果所有行的列数相同,则可以使用INDEXINTCOUNTAMOD将其分解。

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是'输入'范围,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),即0COUNTA只计算非空白单元格)

两者之间的区别是专栏。在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

答案 1 :(得分: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

答案 2 :(得分:0)

在:

enter image description here

后:

enter image description here

代码:

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