使用VBA在Excel中融化/重塑？

Question

我目前正在适应新工作，我与同事共享的大部分工作都是通过MS Excel。我经常使用数据透视表，因此需要“堆叠的”数据，恰恰是我依赖R melt()的reshape（reshape2）包中函数的输出。

谁能让我开始使用VBA宏来完成此任务，或者已经存在？

宏的轮廓为：

在Excel工作簿中选择一个单元格区域。

启动“融化”宏。

宏将创建一个提示，“输入ID列数”，在此输入标识信息前几列。（例如下面的示例R代码为4）。

在excel文件中创建一个名为“ melt”的新工作表，该工作表将堆叠数据，并创建一个名为“ variable”的新列，该列等于原始选择的数据列标题。

换句话说，输出看起来与简单地在R中执行这两行的输出完全相同：

require(reshape)

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

这是一个例子：

# 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

Answer 1

Microsoft最近推出了Power Query，这是一个Excel加载项，它为Excel内的数据操作添加了许多有趣的功能，包括您要查找的内容。内外接的实际功能被称为“逆透视列”，这是解释在这篇文章中。这是要点：下载并安装加载项打开您的Excel / CSV文件选择要熔化/重塑的表/范围在“高级查询”选项卡中，单击“从表”，这将打开“查询编辑器”选择您要熔化/重塑的列（按Ctrl或Shift-Select，不要拖动）在“转换”选项卡中，单击“取消透视列”（您还可以在此处应用其他转换，然后再返回Excel）在“主页”选项卡中，单击“关闭并加载”。这将在Excel中创建具有所需结果的新表/查询对象。

Answer 2

首先创建一个用户窗体，并将其命名为Unpivot_Form，其中包含两个RefEdit字段-rng_id和value_id以及一个提交/执行按钮。我也是R用户，rng_id是包含id的范围，而value_id包含值；两个范围都包括标题。做两个宏：Sub unpivot()Unpivot_Form.ShowEnd Sub另一个宏位于该字段的提交/执行按钮内：Private Sub submit_Click()'Code to unpivot (convert wide to long for excel)Dim rng_id, rng_id_header, val_id As RangeDim colvar, emptyrow, col As IntegerDim new_sheet As Worksheet'Put val_id range into a range objectSet val_id = Range(value_id.Value)'Determine the parameter for the value id range'This is used for the looping later onnumrows = val_id.Rows.Countnumcols = val_id.Columns.Count'Resize changes the "block" to the size defined by the row and column'Offset moves the "block"Set rng_id_header = Range(range_id.Value).Resize(1)Set rng_id = Range(range_id.Value).Offset(1, 0).Resize(numrows - 1)Set new_sheet = Worksheets.Add'Set up the first column and first batch of id varsnew_sheet.ActivateRange("A65535").End(xlUp).Activaterng_id_header.Copy ActiveCellcolvar = Range("XFD1").End(xlToLeft).Column + 1Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Variable"Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Value"'Start populating the value idsFor col = 1 To numcols  'populate var_id  'determine last row   emptyrow = Range("A65535").End(xlUp).Row + 1   'no need to activate to source to copy   rng_id.Copy new_sheet.Cells(emptyrow, 1)  'copy the variable  val_id.Offset(, col - 1).Resize(1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar), Cells(emptyrow + numrows - 2, colvar))  'copy the value  val_id.Offset(1, col - 1).Resize(numrows - 1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar + 1), Cells(emptyrow + numrows - 2, colvar + 1))NextUnload MeEnd Sub请享用！