Question

我需要将目前存储在excel中的单行中的年度费用数据转换为多行的自身复制版本。澄清我的意思，这是一个例子

原始数据源返回：

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

我需要数据看起来像这样

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

我有数以千计的名字，所提取的数据几乎总是不同的名称，所以它也需要能够动态转换这些数据。有没有人用VBA在Excel中做类似的事情？感谢您提前做出的任何回复

Answer 1

只需在原始数据源上创建一个按钮，并将其设置为在单击时使用此宏。

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

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

1 个答案: