Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
861 views
in Technique[技术] by (71.8m points)

arrays - Aggregate, Collate and Transpose rows into columns

I have the following table

 Id     Letter
1001    A
1001    H
1001    H
1001    H

1001    B
1001    H
1001    H
1001    H

1001    H
1001    H
1001    H

1001    A
1001    H
1001    H
1001    H
1001    B

1001    A
1001    H
1001    H
1001    H
1001    B

1001    B
1001    H
1001    H
1001    H
1001    B

1001    H

1001    A
1001    G
1001    H
1001    H
1001    A
1001    B

1002    B
1002    H
1002    H
1002    B

1002    G
1002    H

1002    B
1002    G
1002    G
1002    H

1002    B
1002    G
1002    H
1002    H

1002    G
1002    H
1002    H

1002    H
1002    H
1002    H
1002    M
1002    N

1002    G
1002    H
1002    H
1002    M
1002    M

1002    A
1002    H
1002    H
1002    H
1002    A
1002    B

1002    B
1002    H
1002    H
1002    H

1002    B
1002    H
1002    H
1002    H
1002    A
1002    A

1002    A
1002    H
1002    H
1002    H
1002    H
1002    B

1002    H

1003    G
1003    H
1003    H
1003    N
1003    M

And I'm trying to transpose it to make each different id in the first column and all the letters in the second column with one blank space for each blank row in the original table:

1001 AHHH BHHH HHH AHHHB AHHHB BHHHB H AGHHAB
1002 BHHB GH BGGH BGHH GHH HHHMN GHHMM AHHHAB BHHH BHHHAA AHHHHB H
1003 GHHNM

I have about 100 different id. I tried to do with a formula using TRANSPOSE and TRIM. I also tried with a macro and VLOOKUP seems to be the easiest way but can't find out how

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

You cannot concatenate a range of cells (aka Letters) using native worksheet functions without knowing the scope beforehand. As your collection of strings into groups has random numbers of elements, a VBA loop approach seems the best (if not the only) way to address the issue. The loop can make determinations along the way that a worksheet function is simply incapable of performing.

Tap Alt+F11 and when the Visual Basic Editor (aka VBE) opens, immediately use the pull-down menus to Insert ? Module (Alt+I,M). Paste one or both of the following into the new pane titled something like Book1 - Module1 (Code).

To concatenate the string groups delimited by a space:

Sub concatenate_and_transpose_to_delim_string()
    Dim rw As Long, lr As Long, pid As Long, str As String
    Dim bPutInColumns As Boolean

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        pid = .Cells(2, 1).Value
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                str = str & Chr(32)
                If pid <> .Cells(rw + 1, 1).Value Then
                    .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
                    .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
                End If
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0) = pid
        .Cells(Rows.Count, 4).End(xlUp).Offset(0, 1) = str
    End With
End Sub

To split the string groups into columns:

Sub concatenate_and_transpose_into_columns()
    Dim rw As Long, lr As Long, nr As Long, pid As Long, str As String

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).row
        .Cells(1, 4).Resize(1, 2) = Array("Id", "Letters")
        For rw = 2 To lr
            If IsEmpty(.Cells(rw, 1)) Then
                .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
                str = vbNullString
            ElseIf pid <> .Cells(rw, 1).Value Then
                pid = .Cells(rw, 1).Value
                nr = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).row
                .Cells(nr, 4) = pid
                str = .Cells(rw, 2).Value
            Else
                str = str & .Cells(rw, 2).Value
            End If
        Next rw
        .Cells(nr, Columns.Count).End(xlToLeft).Offset(0, 1) = str
    End With
End Sub

Tap Alt+Q to return to your worksheet. With your sample data on the active worksheet starting with Id in A1, tap Alt+F8 to open the Macros dialog and Run the macro.

Results from concatenate_and_transpose_to_delim_string:

????Concatenate and Transpose to delim strang

Results from concatenate_and_transpose_into_columns:

????Concatenate and Transpose

The results will be written into the cells starting at D2. Probably best if there was nothing important there beforehand that would be overwritten.

Addendum:

I original misinterpreted your request and split the string groups into separate columns. I've rectified that with a supplemental routine that more closely follows your description of requirements but kept both variations for others to reference.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...