vba 使用VBA在excel中熔化/重塑？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/10921791/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
melt / reshape in excel using VBA?
提问by baha-kev
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.
我目前正在适应一份新工作，我与同事分享的大部分工作都是通过 MS Excel 完成的。我经常使用数据透视表，因此需要“堆叠”数据，正是我为此依赖的 R 中 (reshape2) 包中melt()函数的输出reshape。
Could anyone get me started on a VBA macro to accomplish this, or does one exist already?
任何人都可以让我开始使用 VBA 宏来完成此操作，还是已经存在？
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.
- 在 Excel 工作簿中选择一系列单元格。
- 启动“熔化”宏。
- 宏将创建一个提示，“输入 id 列数”，您可以在其中输入识别信息列的前面的数量。（对于下面的示例 R 代码，它是 4）。
- 在 Excel 文件中创建一个名为“melt”的新工作表，用于堆叠数据，并创建一个名为“variable”的新列，该列等于原始选择中的数据列标题。
In other words, the output would look exactly the same as the output of simply executing these two lines in R:
换句话说，输出看起来与在 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
回答by Doug Glancy
I've got two posts, with usable code and downloadable workbook, on doing this in Excel/VBA on my blog:
我在我的博客上有两篇关于在 Excel/VBA 中执行此操作的帖子，其中包含可用的代码和可下载的工作簿：
http://yoursumbuddy.com/data-normalizer
http://yoursumbuddy.com/data-normalizer
http://yoursumbuddy.com/data-normalizer-the-sql/
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
'columns that will be repeated must be to the left,
'with the columns 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
回答by baha-kev
Microsoft recently came out with Power Query, an Excel Add-In which adds a lot of interesting functions and capabilities to data manipulation from within Excel, including what you're looking for.
Microsoft 最近推出了 Power Query，这是一个 Excel 插件，它为 Excel 中的数据操作添加了许多有趣的功能和功能，包括您正在寻找的内容。
The actual function within the Add-In is called "Unpivot Columns", which is explained in this article. Here's the gist of it:
内外接的实际功能被称为“逆透视列”，这是解释在这篇文章中。这是它的要点：
- Download and install the add-in
- Open up your Excel/CSV file
- Select the table/range you want to melt/reshape
- In the "Power Query" tab, click on "From Table", which will open the "Query Editor"
- Select the columns you want to melt/reshape (ctrl or shift-select, don't drag)
- In the "Transform" tab click on "Unpivot Columns" (you can also apply other transformations here before returning to Excel)
- In the "Home" tab click "Close & Load". This will create a new table/query object in Excel with the desired result.
- 下载并安装插件
- 打开你的 Excel/CSV 文件
- 选择要融化/重塑的表格/范围
- 在“Power Query”选项卡中，单击“来自表”，这将打开“查询编辑器”
- 选择要融合/重塑的列（Ctrl 或 Shift-select，不要拖动）
- 在“转换”选项卡中单击“逆透视列”（您也可以在返回 Excel 之前在此处应用其他转换）
- 在“主页”选项卡中单击“关闭并加载”。这将在 Excel 中创建一个具有所需结果的新表/查询对象。
回答by Tom McMahon
For anyone looking for a visual way to normalize excel data, see this video tutorial:
对于正在寻找标准化 Excel 数据的可视化方法的任何人，请参阅此视频教程：
回答by snb
or use:
或使用：
Sub M_snb_000()
With sheet1.Cells(1).CurrentRegion
sn = .Resize(, .Columns.Count + 1)
End With
For j = 4 To UBound(sn, 2) - 1
With Sheet2.Cells(2 + (UBound(sn) - 1) * (j - 4), 1)
.Resize(UBound(sn) - 1, 5) = Application.Index(sn, Evaluate("row(2:"
& UBound(sn) & ")"), Array(1, 2, 3,UBound(sn, 2), j))
.Resize(UBound(sn) - 1, 1).Offset(, 3) = sn(1, j)
End With
Next
End Sub
回答by Raphael Lee
First create a Userform and name it Unpivot_Form with two RefEdit fields - rng_id and value_id and a submit/go button. I am also an R user and rng_id is the range that contains the id while value_id contains the value; both range inclusive of header.
首先创建一个用户表单并将其命名为 Unpivot_Form，其中包含两个 RefEdit 字段 - rng_id 和 value_id 以及一个提交/执行按钮。我也是 R 用户，rng_id 是包含 id 的范围，而 value_id 包含值；两个范围都包括标题。
Do two macro:
做两个宏：
Sub unpivot()
Unpivot_Form.Show
End Sub
Another macro is within the submit/go button of the field:
另一个宏位于该字段的提交/执行按钮内：
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
Enjoy!
享受！
