使用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_games2 2010     5     USA Soccer       4         3          5           93 2010     6     USA Soccer       5         3          4           84 2010     5     CAN Soccer       2         9          7          115 2010     6     CAN Soccer       4         8          4          136 2009     5     USA Soccer       8         1          4           97 2009     6     USA Soccer       0         0          3           28 2009     5     CAN Soccer       2         0          6           39 2009     6     CAN Soccer       3         0          8           3# stacking the data> require(reshape)> melt(df1, id.vars=1:4)  Year Month Country  Sport    variable value1  2010     5     USA Soccer     No_wins     42  2010     6     USA Soccer     No_wins     53  2010     5     CAN Soccer     No_wins     24  2010     6     CAN Soccer     No_wins     45  2009     5     USA Soccer     No_wins     86  2009     6     USA Soccer     No_wins     07  2009     5     CAN Soccer     No_wins     28  2009     6     CAN Soccer     No_wins     39  2010     5     USA Soccer   No_losses     310 2010     6     USA Soccer   No_losses     311 2010     5     CAN Soccer   No_losses     912 2010     6     CAN Soccer   No_losses     813 2009     5     USA Soccer   No_losses     114 2009     6     USA Soccer   No_losses     015 2009     5     CAN Soccer   No_losses     016 2009     6     CAN Soccer   No_losses     017 2010     5     USA Soccer  High_score     518 2010     6     USA Soccer  High_score     419 2010     5     CAN Soccer  High_score     7

Answer 1

Microsoft最近推出了Power Query，这是一个Excel加载项，它为Excel内的数据操作添加了许多有趣的功能，包括您要查找的内容。

内外接的实际功能被称为“逆透视列”，这是解释在这篇文章中。这是要点：

1. 下载并安装加载项

2. 打开您的Excel / CSV文件

3. 选择要熔化/重塑的表/范围

4. 在“高级查询”选项卡中，单击“从表”，这将打开“查询编辑器”

5. 选择您要熔化/重塑的列（按Ctrl或Shift-Select，不要拖动）

6. 在“转换”选项卡中，单击“取消透视列”（您还可以在此处应用其他转换，然后再返回Excel）

7. 在“主页”选项卡中，单击“关闭并加载”。这将在Excel中创建具有所需结果的新表/查询对象。

Answer 2

首先创建一个用户窗体，并将其命名为Unpivot_Form，其中包含两个RefEdit字段-rng_id和value_id以及一个提交/执行按钮。我也是R用户，rng_id是包含id的范围，而value_id包含值；两个范围都包括标题。

做两个宏：

Sub unpivot()

Unpivot_Form.Show

End Sub

另一个宏位于该字段的提交/执行按钮内：

Private Sub submit_Click()

'Code to unpivot (convert wide to long for excel)

Dim rng_id, rng_id_header, val_id As Range

Dim colvar, emptyrow, col As Integer

Dim new_sheet As Worksheet

'Put val_id range into a range object

Set val_id = Range(value_id.Value)

'Determine the parameter for the value id range

'This is used for the looping later on

numrows = val_id.Rows.Count

numcols = 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 vars

new_sheet.Activate

Range("A65535").End(xlUp).Activate

rng_id_header.Copy ActiveCell

colvar = Range("XFD1").End(xlToLeft).Column + 1

Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Variable"

Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Value"

'Start populating the value ids

For 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))

Next

Unload Me

End Sub

请享用！