将Excel行的一部分转置为其他行VBA中的自身副本？

Question

I need to transpose yearly expense data currently stored in a single row in excel, to a copied version of itself in multiple rows. to clarify what i mean, here is an example

original data source returns this:

Name    Title   Year1Expense Year2Expense Year3Expense Year4Expense  other1   other 2   etc
Bob     Tech       30,000       17,000      20,000       18,000

i need the data to look like this

Name    Title   Year    Expense   other1   other2   etc
Bob     Tech     1       30,000
Bob     Tech     2       17,000
Bob     Tech     3       20,000
Bob     Tech     4       18,000

I have thousands of names, and the data pulled is almost always different counts of names, so it needs to be able to dynamically convert this data as well. Has anyone used VBA to do something similar in Excel? thanks for any responses in advance

Answer 1

Just create a button on the original data source and set it to use this macro when clicked.

Sub Transpose_Click()

Dim numberOfRows, numberOfColumns, numberOfYears, counter, nextRow As Integer, originalSheet As String
originalSheet = ActiveSheet.Name
nextRow = 2
numberOfColumns = Range("A1").End(xlToRight).Column
numberOfYears = 0
counter = 5
For i = 1 To numberOfColumns
    If LCase(Left(CStr(Cells(1, i).Value), 4)) = "year" Then
        numberOfYears = numberOfYears + 1
    End If
Next
numberOfRows = Range("A1").End(xlDown).Row

Dim wsSheet As Worksheet
On Error Resume Next
Set wsSheet = Sheets("TransposedData")
On Error GoTo 0
If Not wsSheet Is Nothing Then
MsgBox "Sheet already exists, overwriting"
Else
MsgBox "Creating new sheet"
Sheets.Add.Name = "TransposedData"
End If

With Sheets("TransposedData")
    .Cells.Delete
    .Range("A1").Value = "Name"
    .Range("B1").Value = "Title"
    .Range("C1").Value = "Year"
    .Range("D1").Value = "Expense"
    For i = numberOfYears + 3 To numberOfColumns
        .Cells(1, counter).Value = Sheets(originalSheet).Cells(1, i).Value
        counter = counter + 1
    Next
    For i = 2 To numberOfRows
        For j = 1 To numberOfYears
            .Cells(nextRow, 1).Value = Sheets(originalSheet).Cells(i, 1).Value
            .Cells(nextRow, 2).Value = Sheets(originalSheet).Cells(i, 2).Value
            .Cells(nextRow, 3).Value = j
            .Cells(nextRow, 4).Value = Sheets(originalSheet).Cells(i, 2 + j).Value
            For k = 1 To (numberOfColumns - 2 - numberOfYears)
                .Cells(nextRow, 4 + k).Value = Sheets(originalSheet).Cells(i, 2 + numberOfYears + k).Value
            Next
            nextRow = nextRow + 1
        Next
    Next
End With

End Sub