开发者

Transpose Excel data using VBA

I have Excel data that looks like the top two 开发者_如何学编程rows of the following:

Transpose Excel data using VBA

I need to get it looking like the data on the bottom rows.


A very easy way of doing this is by using the transpose option of Paste Special, depending on how much data you have. For a small amount it's worth doing it this way.

  1. Select B1:E1
  2. Copy.
  3. Select where you want it pasted.
  4. Go to Edit, Paste Special and choose transpose
  5. It will now be shown vertically. Just fill in the name Joe Bloggs and fill it down.

If you have a lot of different people, Joe Bloggs, Jane Doe and many more it would be a chore to transpose each individual person so a quick bit of VB code like horrible thing below should do the trick.

Public Sub test()
    Dim rowFound As Boolean, columnFound As Boolean, y As Long, x As Long, rowCounter As Long
    Dim thisSheet As Excel.Worksheet, resultSheet As Excel.Worksheet
    Set thisSheet = ActiveWorkbook.Sheets("Sheet1")
    Set resultSheet = ActiveWorkbook.Sheets("Sheet2")
    rowFound = True
    y = 0
    rowCounter = 0
    Do While rowFound
        columnFound = True
        Dim foundName As String
        foundName = thisSheet.Range("A1").Offset(y).Value
        If foundName = "" Then
            rowFound = False
        Else
            x = 0
            Do While columnFound
                If thisSheet.Range("B1").Offset(y, x).Value = "" Then
                    columnFound = False
                Else
                    resultSheet.Range("A1").Offset(rowCounter).Value = foundName
                    resultSheet.Range("B1").Offset(rowCounter).Value = thisSheet.Range("B1").Offset(y, x).Value
                    rowCounter = rowCounter + 1
                End If
                x = x + 1
            Loop
        End If
        y = y + 1
    Loop
End Sub

x and y are used like a set of graph coordinates. For every row it scans through the columns in the row, and adds it to the list below.

Edit:
I've updated the code, Integers are now Long and it writes the results to sheet2.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜