使用VBA融合/重塑excel？ [英] melt / reshape in excel using VBA?
本文介绍了使用VBA融合/重塑excel？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
reshape中的 melt（）函数的输出（reshape2）包，我已经依赖这个。 有没有人可以让我开始一个VBA宏来完成这个或者是否存在？
宏的大纲是：
- 在Excel工作簿中选择一系列单元格。
- 开始融化宏。
- 宏会创建一个提示输入ID列号，您可以在其中输入前面列的数字识别信息。 （例如，下面的代码为4）。
- 在名为melt
的excel文件中创建一个新的工作表，该文件将堆栈数据，并创建一个名为变量
等于原始选择中的数据列标题。
换句话说，输出将正好与在R中简单执行这两行的输出相同：
require（reshape）
melt（your。 unsacked.dataframe，id.vars = 1：4）
这里有一个例子：
＃拆包数据
> df1
年月国家运动No_wins No_losses High_score Total_games
2 2010 5美国足球4 3 5 9
3 2010 6美国足球5 3 4 8
4 2010 5 CAN Soccer 2 9 7 11
5 2010 6 CAN足球4 8 4 13
6 2009 5美国足球8 1 4 9
7 2009 6美国足球0 0 3 2
8 2009 5 CAN足球2 0 6 3
9 2009 6 CAN Soccer 3 0 8 3
＃堆叠数据
> require（reshape）
> （df1，id.vars = 1：4）
年月份国家体育变量值
1 2010 5美国足球No_wins 4
2 2010 6美国足球No_wins 5
3 2010 5 CAN Soccer No_wins 2
4 2010 6 CAN Soccer No_wins 4
5 2009 5美国足球No_wins 8
6 2009 6美国足球No_wins 0
7 2009 5 CAN足球No_wins 2
8 2009 6 CAN足球No_wins 3
9 2010 5美国足球No_losses 3
10 2010 6美国足球No_losses 3
11 2010 5 CAN Soccer No_losses 9
12 2010 6 Can Soccer No_losses 8
13 2009 5美国足球No_losses 1
14 2009 6美国足球No_losses 0
15 2009 5 CAN Soccer No_losses 0
16 2009 6 CAN Soccer No_losses 0
17 2010 5美国足球High_score 5
18 2010 6美国足球H igh_score 4
19 2010 5 CAN Soccer High_score 7
20 2010 6 CAN Soccer High_score 4
21 2009 5 USA Soccer High_score 4
22 2009 6 USA Soccer High_score 3
23 2009 5 CAN Soccer High_score 6
24 2009 6 CAN Soccer High_score 8
25 2010 5美国足球Total_games 9
26 2010 6美国足球Total_games 8
27 2010 5 CAN Soccer Total_games 11
28 2010 6 CAN Soccer Total_games 13
29 2009 5美国足球Total_games 9
30 2009 6美国足球Total_games 2
31 2009 5 CAN Soccer Total_games 3
32 2009 6 CAN Soccer Total_games 3
解决方案
我有两个帖子，可用的代码和可下载的工作簿，在我的博客上的Excel / VBA中执行此操作：
http://yoursumbuddy.com/data-normalizer
http://yoursumbuddy.com/data-normalizer-the-sql/
这里是代码：
'参数
'列表：要归一化的范围。
'RepeatingColsCount：从最左边开始的列数，
'的标题保持不变。
'NormalizedColHeader：汇总类别的列标题。
'DataColHeader：标准化数据的列标题。
'NewWorkbook：将工作表与数据放在一个新的工作簿中？
'
'注意：数据必须在一个连续的范围内，将要重复的
'行必须在左边，
'，这些行被归一化为正确的。
Sub NormalizeList（List as Excel.Range，RepeatingColsCount As Long，_
NormalizedColHeader As String，DataColHeader As String，_
可选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
列表
'如果规范化列表不合适，您必须退出。
如果.Rows.Count *（.Columns.Count - RepeatingColsCount）> .Parent.Rows.Count然后
MsgBox规范化列表将太多行，_
vbExclamation + vbOKOnly，对不起
退出子
结束如果
'您的范围要归一化，最左边行的数量要重复。
'此部分使用这些参数设置两个范围来解析
'和两个相应的数组来填充
FirstNormalizingCol = RepeatingColsCount + 1
NormalizingColsCount = .Columns.Count - RepeatingColsCount
设置ColsToRepeat = .Cells（1）.Resize（.Rows.Count，RepeatingColsCount）
设置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
'用重复的行标签填充重复数组的每个i元素。
对于i = 1 To NormalizedRowsCount Step NormalizingColsCount
ListIndex = ListIndex + 1
对于j = 1对RepeatingColsCount
RepeatingList（i，j）= List.Cells（ListIndex，j） .Value2
下一步j
下一步i
'我们走过上面的大部分行，所以填写其他重复的数组元素。
对于i = 1 To NormalizedRowsCount
对于j = 1对RepeatingColsCount
如果RepeatingList（i，j）=然后
RepeatingList（i，j）= RepeatingList（i - 1，j）
End If
Next j
Next i
'将规范化数组
'的第一维中的每个元素填充到前列标题（现在是另一行标签）和数据。
使用ColsToNormalize
对于i = 1 To .Rows.Count
对于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
结束与
'将正常数据放在同一个工作簿或一个新的工作簿中。
如果NewWorkbook然后
设置wbTarget = Workbooks.Add
设置wsTarget = wbTarget.Worksheets（1）
Else
设置wbSource = List.Parent.Parent
用wbSource.Worksheets
设置wsTarget = .Add（之后：=。Item（.Count））
结束
结束如果
使用wsTarget
'将两个数组中的数据放在新工作表中。
.Range（A1）。Resize（NormalizedRowsCount，RepeatingColsCount）= RepeatingList
.Cells（1，FirstNormalizingCol）.Resize（NormalizedRowsCount，2）= NormalizedList
'At这一点会有重复的头行，所以删除除了一个。
.Range（1：& NormalizingColsCount - 1）.EntireRow.Delete
'添加新标签列和数据列的标题。
.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
I'm currently adjusting to a new job where most of the work I share with colleagues is via MS Excel. I am using pivot tables frequently, and therefore need "stacked" data, precisely the output of the melt() function in the reshape (reshape2) package in R that I've come to rely on for this.
Could anyone get me started on a VBA macro to accomplish this, or does one exist already?
The outline of the macro would be:
- Select a range of cells in an Excel workbook.
- Start "melt" macro.
- Macro would create a prompt, "Enter number of id columns", where you would enter the number preceding columns of identifying information. (for the example R code below it's 4).
- Create a new worksheet in the excel file titled "melt" that would stack the data, and create a new column titled "variable" equal to the data column headers from the original selection.
In other words, the output would look exactly the same as the output of simply executing these two lines in R:
require(reshape)
melt(your.unstacked.dataframe, id.vars = 1:4)
Here's an example:
# unstacked data
> df1
Year Month Country Sport No_wins No_losses High_score Total_games
2 2010 5 USA Soccer 4 3 5 9
3 2010 6 USA Soccer 5 3 4 8
4 2010 5 CAN Soccer 2 9 7 11
5 2010 6 CAN Soccer 4 8 4 13
6 2009 5 USA Soccer 8 1 4 9
7 2009 6 USA Soccer 0 0 3 2
8 2009 5 CAN Soccer 2 0 6 3
9 2009 6 CAN Soccer 3 0 8 3
# stacking the data
> require(reshape)
> melt(df1, id.vars=1:4)
Year Month Country Sport variable value
1 2010 5 USA Soccer No_wins 4
2 2010 6 USA Soccer No_wins 5
3 2010 5 CAN Soccer No_wins 2
4 2010 6 CAN Soccer No_wins 4
5 2009 5 USA Soccer No_wins 8
6 2009 6 USA Soccer No_wins 0
7 2009 5 CAN Soccer No_wins 2
8 2009 6 CAN Soccer No_wins 3
9 2010 5 USA Soccer No_losses 3
10 2010 6 USA Soccer No_losses 3
11 2010 5 CAN Soccer No_losses 9
12 2010 6 CAN Soccer No_losses 8
13 2009 5 USA Soccer No_losses 1
14 2009 6 USA Soccer No_losses 0
15 2009 5 CAN Soccer No_losses 0
16 2009 6 CAN Soccer No_losses 0
17 2010 5 USA Soccer High_score 5
18 2010 6 USA Soccer High_score 4
19 2010 5 CAN Soccer High_score 7
20 2010 6 CAN Soccer High_score 4
21 2009 5 USA Soccer High_score 4
22 2009 6 USA Soccer High_score 3
23 2009 5 CAN Soccer High_score 6
24 2009 6 CAN Soccer High_score 8
25 2010 5 USA Soccer Total_games 9
26 2010 6 USA Soccer Total_games 8
27 2010 5 CAN Soccer Total_games 11
28 2010 6 CAN Soccer Total_games 13
29 2009 5 USA Soccer Total_games 9
30 2009 6 USA Soccer Total_games 2
31 2009 5 CAN Soccer Total_games 3
32 2009 6 CAN Soccer Total_games 3
解决方案
I've got two posts, with usable code and downloadable workbook, on doing this in Excel/VBA on my blog:
http://yoursumbuddy.com/data-normalizer
http://yoursumbuddy.com/data-normalizer-the-sql/
Here's the code:
'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
You’d call it like this:
Sub TestIt()
NormalizeList ActiveSheet.UsedRange, 4, "Variable", "Value", False
End Sub
这篇关于使用VBA融合/重塑excel？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
