使用VBA融合/重塑excel？

我目前正在調整一份新工作,我與大家分享的大部分工作都是通過MS Excel.我經常使用樞軸表,因此需要“堆疊”資料,正是我所依賴的R中的reshape(reshape2)包中的melt()函式的輸出.

有沒有人可以讓我開始一個VBA巨集來完成這個,還是有一個已經存在？

巨集觀大綱將是：

>在Excel工作簿中選擇一系列單元格.

>開始“融化”巨集.

>巨集將建立一個提示符“輸入ID列數”,您可以在其中輸入前面列出的標識資訊. (例如,下面的程式碼是4).

>在excel檔案中建立一個名為“melt”的新工作表

這將堆疊資料,並建立一個名為“變數”的新列

等於原始選擇的資料列標題.

換句話說,輸出將看起來與在R中簡單執行這兩行的輸出完全相同：

require(reshape)
melt(your.unstacked.dataframe, id.vars = 1:4)

以下是一個例子：

# unstacked data
> df1
Year Month CountrySport No_wins No_losses High_score Total_games
2 20105USA Soccer4359
3 20106USA Soccer5348
4 20105CAN Soccer29711
5 20106CAN Soccer48413
6 20095USA Soccer8149
7 20096USA Soccer0032
8 20095CAN Soccer2063
9 20096CAN Soccer3083

# stacking the data
> require(reshape)
> melt(df1, id.vars=1:4)

Year Month CountrySportvariable value
120105USA SoccerNo_wins4
220106USA SoccerNo_wins5
320105CAN SoccerNo_wins2
420106CAN SoccerNo_wins4
520095USA SoccerNo_wins8
620096USA SoccerNo_wins0
720095CAN SoccerNo_wins2
820096CAN SoccerNo_wins3
920105USA SoccerNo_losses3
10 20106USA SoccerNo_losses3
11 20105CAN SoccerNo_losses9
12 20106CAN SoccerNo_losses8
13 20095USA SoccerNo_losses1
14 20096USA SoccerNo_losses0
15 20095CAN SoccerNo_losses0
16 20096CAN SoccerNo_losses0
17 20105USA SoccerHigh_score5
18 20106USA SoccerHigh_score4
19 20105CAN SoccerHigh_score7
20 20106CAN SoccerHigh_score4
21 20095USA SoccerHigh_score4
22 20096USA SoccerHigh_score3
23 20095CAN SoccerHigh_score6
24 20096CAN SoccerHigh_score8
25 20105USA Soccer Total_games9
26 20106USA Soccer Total_games8
27 20105CAN Soccer Total_games11
28 20106CAN Soccer Total_games13
29 20095USA Soccer Total_games9
30 20096USA Soccer Total_games2
31 20095CAN Soccer Total_games3
32 20096CAN Soccer Total_games3

我有兩個帖子,有可用的程式碼和可下載的工作簿,在我的部落格上的Excel / VBA中進行此操作：

ofollow,noindex" target="_blank">http://yoursumbuddy.com/data-normalizer

http://yoursumbuddy.com/data-normalizer-the-sql/

以下是程式碼：

'Arguments
'List: The range to be normalized.
'RepeatingColsCount: The number of columns, starting with the leftmost,
'whose headings remain the same.
'NormalizedColHeader: The column header for the rolled-up category.
'DataColHeader: The column header for the normalized data.
'NewWorkbook: Put the sheet with the data in a new workbook?
'
'NOTE: The data must be in a contiguous range and the
'rows that will be repeated must be to the left,
'with the rows to be normalized to the right.

Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
NormalizedColHeader As String, DataColHeader As String, _
Optional NewWorkbook As Boolean = False)

Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet

With List
'If the normalized list won't fit, you must quit.
If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
MsgBox "The normalized list will be too many rows.", _
vbExclamation + vbOKOnly, "Sorry"
Exit Sub
End If

'You have the range to be normalized and the count of leftmost rows to be repeated.
'This section uses those arguments to set the two ranges to parse
'and the two corresponding arrays to fill
FirstNormalizingCol = RepeatingColsCount + 1
NormalizingColsCount = .Columns.Count - RepeatingColsCount
Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
End With

'Fill in every i elements of the repeating array with the repeating row labels.
For i = 1 To NormalizedRowsCount Step NormalizingColsCount
ListIndex = ListIndex + 1
For j = 1 To RepeatingColsCount
RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
Next j
Next i

'We stepped over most rows above, so fill in other repeating array elements.
For i = 1 To NormalizedRowsCount
For j = 1 To RepeatingColsCount
If RepeatingList(i, j) = "" Then
RepeatingList(i, j) = RepeatingList(i - 1, j)
End If
Next j
Next i

'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
With ColsToNormalize
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
Next j
Next i
End With

'Put the normal data in the same workbook, or a new one.
If NewWorkbook Then
Set wbTarget = Workbooks.Add
Set wsTarget = wbTarget.Worksheets(1)
Else
Set wbSource = List.Parent.Parent
With wbSource.Worksheets
Set wsTarget = .Add(after:=.Item(.Count))
End With
End If

With wsTarget
'Put the data from the two arrays in the new worksheet.
.Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
.Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList

'At this point there will be repeated header rows, so delete all but one.
.Range("1:" & NormalizingColsCount - 1).EntireRow.Delete

'Add the headers for the new label column and the data column.
.Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
.Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
End With
End Sub

你會這樣稱呼：

Sub TestIt()
NormalizeList ActiveSheet.UsedRange, 4, "Variable", "Value", False
End Sub