Excel - transpose pairs of columns

问题

I'm attempting to transpose - if that's the right application of the term - pairs of columns into repeating rows. In concrete terms, I need to go from this:

Thing1     6    0.29    5   0.23    7   0.19    8   0.11

to this:

Thing1     6    0.29
Thing1     5    0.23
Thing1     7    0.19
Thing1     8    0.11

This operation will occur with at least 7 pairs of columns for several hundred "things." The part I can't figure out is how to group/lock the pairs to be treated as one unit.

In some ways, I'm trying to do the opposite of what is normally done. One example is here: Transpose and group data but it doesn't quite fit, even if I attempt to look at it backwards.

EDIT: Another example that is similar, but I need to do almost the reverse: How to transpose one or more column pairs to the matching record in Excel?

My VBA kung fu is weak, but I'm willing to try whatever your collective wisdom suggests.

Ideas are welcome, and in any case, thank you for reading.

回答1:

Here is a VBA solution.

To implement this, press Alt+F11 to open the VBA editor.

Right click to the left side and select "Insert Module"

Paste the code into the right side of this.

You may want to change the output sheet name as I have shown in the code.

I use Sheet2 to place the transposed data, but you can use whatever you want.

After you have done this, you may close the editor and select the sheet with your non-transposed data.

Run the macro by pressing Alt+F8, clicking on the macro, and pressing Run

Sheet2 should contain the results you are looking for.

Sub ForJeremy() 'You can call this whatever you want
Dim EndCol, OutSheet, OutRow, c, x
Application.ScreenUpdating = False
EndCol = ActiveSheet.UsedRange.columns.Count

'What sheet do I put these values on?
Set OutSheet = Sheets("Sheet2") 'Put the name in the quotes

OutSheet.Cells.Delete xlShiftUp 'This clears the output sheet.
OutRow = 1
For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
    For x = 2 To EndCol Step 2
        OutSheet.Cells(OutRow, 1) = c.Value
        OutSheet.Cells(OutRow, 2) = Cells(c.Row, x)
        OutSheet.Cells(OutRow, 3) = Cells(c.Row, x + 1)
        OutRow = OutRow + 1
    Next x
Next c
OutSheet.Select
Application.ScreenUpdating = True
End Sub

Input:

Output:

Edit: If you wanted to add an additional column to the beginning that would also just display to the side, you would change the code like this:

For Each c In Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:A"))
    For x = 3 To EndCol Step 2 'Changed 2 to 3
        OutSheet.Cells(OutRow, 1) = c.Value
        OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line
        OutSheet.Cells(OutRow, 3) = Cells(c.Row, x) 'Changed to Col 3
        OutSheet.Cells(OutRow, 4) = Cells(c.Row, x + 1) 'Changed to Col 4
        OutRow = OutRow + 1
    Next x
Next c

To better explain this loop,

It goes through each cell in column A from the top to the bottom.

The inner loop scoots over 2 columns at a time.

So we start at column B, and next is D, and next is F .. and so on.

So once we have that value, we grab the value to the right of it as well.

That's what the Cells(c.Row, x) and Cells(c.Row, x + 1) does.

The OutSheet.Cells(OutRow, 1) = c.Value says - just make the first column match the first column.

When we add the second one, OutSheet.Cells(OutRow, 2) = Cells(c.Row, 2) 'Added this line we are saying, match the second column too.

Hope I did a decent job explaining.

回答2:

Here is the Excel formula solution just in case. If the source data starts at A1, then formula in the first destination cell will be =$A$1 and the 2 formulas to the right will be

= OFFSET( A$1, 0, ROW( A1 ) * 2 - 1 )

and

= OFFSET( A$1, 0, ROW( A1 ) * 2 )

copy the 3 formula cells and paste in the range below them

Update

VBA version (set r to the source range and replace c3 with the first cell in the destination range)

Set r = [a1:i1]
set d = [c3].Resize(r.Count \ 2, 3)
d.Formula = "=index(" & r.Address & ",if(column(a1)=1,1,row(a1)*2-2+column(a1)))"

来源：https://stackoverflow.com/questions/38910778/excel-transpose-pairs-of-columns

标签

excel

offset

transpose