Excel VBA，数据转换导致excel崩溃
Excel VBA，数据转换导致excel崩溃
提问于 2018-05-28 18:09:27
我有一个代码崩溃了我的excel，它从一个工作表中获取数据，并将其从表格视图转换为垂直视图。我认为它很慢，因为它正在将它从数据库视图移到超过45k行。
有人有优化这段代码的技巧吗？在next c循环中崩溃我的excel
我还试着在excel 2010中运行这个程序，得到一个overflow错误，但是通常2010年运行得更好，而2013年运行缓慢或者没有响应。但我想让它在2013年发挥作用。
Sub test()
Call ReversePivotTable("Sheet1", "A", "C", "Sheet2", "Name")
End Sub
Sub ReversePivotTable(source_sheet, from_col, to_col, target_sheet, Optional type_header = "type", Optional value_header = "value")
Application.ScreenUpdating = False
LAST_ROW = Sheets(source_sheet).Cells(Rows.count, 1).End(xlUp).Row
If LAST_ROW > 1 Then
Sheets(target_sheet).Cells.ClearContents
Else
Exit Sub
End If
pvt_type_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 1).column 'D
pvt_value_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 2).column 'E
'get headers
Sheets(source_sheet).Range(from_col & ":" & to_col).copy
Sheets(target_sheet).Range("A1").PasteSpecial xlPasteValues
Sheets(target_sheet).Cells(1, pvt_type_col).Value = type_header
Sheets(target_sheet).Cells(1, pvt_value_col).Value = value_header
'tranform data
curr_row = 2
With Sheets(source_sheet)
last_col = .Cells(1, Columns.count).End(xlToLeft).column
For Each c In .Range("A2", .Range("A" & Rows.count).End(xlUp))
Set rng = .Range(.Cells(c.Row, pvt_type_col), .Cells(c.Row, last_col))
numbers = Application.WorksheetFunction.CountIf(rng, "<>""")
If numbers > 0 Then
Sheets(source_sheet).Range(from_col & c.Row & ":" & to_col & c.Row).copy
Sheets(target_sheet).Range(from_col & curr_row & ":" & from_col & curr_row + numbers - 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
b = curr_row
For a = pvt_type_col To last_col Step 1
If IsNumeric(.Cells(c.Row, a).Value) Then
'If .Cells(c.Row, a).Value <> "" Then
Sheets(target_sheet).Cells(b, pvt_type_col) = .Cells(1, a)
Sheets(target_sheet).Cells(b, pvt_value_col) = .Cells(c.Row, a)
b = b + 1
End If
Next a
curr_row = curr_row + numbers
If curr_row Mod 10 = 0 Then DoEvents
End If
Next c
End With
Sheets(target_sheet).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub在添加样本数据之前：
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+
| col 1 | col 2 | col 3 | col 4 | col 5 | col 6 | col 7 | col 8 | col 9 | col 10 | col 11 | col 12 | col 13 | col 14 | col 15 | col 16 | col 17 | col 18 | col 19 | col 20 | col 21 | col 22 | col 23 | col 24 | col 25 | col 26 | col 27 | col 28 | col 29 | col 30 | col 31 | col 32 | col 33 | col 34 | col 35 | col 36 | col 37 | col 38 | col 39 | col 40 | col 41 | col 42 | col 43 | col 44 | col 45 | col 46 | col 47 | col 48 | col 49 |
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+
| stack | questions forums | excel questions | -540.0689323 | 1543.570725 | -144.7954348 | 2298.261951 | -9019.970702 | -14669.27805 | 2400.31011 | 642.2459256 | 5573.176935 | -19167.60096 | -17070.78503 | 2884.343252 | 2262.2904 | 0 | 0 | 0 | -4866.524221 | -5470.616311 | 6722.889306 | -6749.153327 | 8483.707603 | 7513.052842 | 3768.659869 | 8600.703543 | -8642.799155 | 1322.251923 | -1323.911031 | 3651.739593 | -259.3401823 | 9369.890794 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -325.5117945 | 641.8568521 | -58.21010305 | 977.4626836 | -3505.695779 | -7455.410001 | 777.9341271 | 385.2714806 | 1932.531773 | -8861.136183 | -6679.463121 | 1177.775583 | 881.2548725 | 0 | 0 | 0 | -1813.822794 | -2266.860562 | 2278.669772 | -2361.758467 | 3356.446385 | 2741.992369 | 1461.950204 | 3289.154294 | -3469.10217 | 804.7989704 | -816.9003551 | 1907.515323 | 432.8435868 | 3074.256129 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -36.42618332 | 65.26139258 | -6.513963305 | 99.38442773 | -435.0485137 | -1047.099199 | 79.09717611 | 39.17283622 | 186.7060257 | -1272.372107 | -922.750792 | 118.3261869 | 89.60240903 | 0 | 0 | 0 | -210.3183182 | -267.1376584 | 214.6223869 | -280.0000537 | 293.4738136 | 248.5196226 | 144.0720039 | 288.5506437 | -430.0886416 | 81.82868405 | -91.41469707 | 184.4395708 | 44.00977438 | 272.8284368 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| stack | questions forums | excel questions | -582.3647427 | 1316.573479 | -165.4555206 | 1925.519573 | -7138.977944 | -17532.94829 | 1404.004642 | 930.6126154 | 3648.013625 | -19585.55834 | -13758.8035 | 2376.319408 | 1898.9449 | 0 | 0 | 0 | -3625.886962 | -4833.808881 | 4232.764078 | -4449.956081 | 6883.584715 | 5398.12044 | 4048.773452 | 6632.405148 | -7240.871663 | 1959.676076 | -2008.657583 | 4413.431721 | 1360.661107 | 5484.849776 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
+---------+------------------+-----------------+--------------+-------------+--------------+-------------+--------------+--------------+-------------+-------------+-------------+--------------+--------------+-------------+-------------+--------+--------+--------+--------------+--------------+-------------+--------------+-------------+-------------+-------------+-------------+--------------+-------------+--------------+-------------+--------------+-------------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+--------+希望在下列情况之后：
+---------+------------------+-----------------+-----------+--------------+
| col 1 | col 2 | col 3 | Attribute | Value |
+---------+------------------+-----------------+-----------+--------------+
| stack | questions forums | excel questions | col 4 | -540.0689323 |
| stack | questions forums | excel questions | col 5 | 1543.570725 |
| stack | questions forums | excel questions | col 6 | -144.7954348 |
| stack | questions forums | excel questions | col 7 | 2298.261951 |
| stack | questions forums | excel questions | col 8 | -9019.970702 |
| stack | questions forums | excel questions | col 9 | -14669.27805 |
| stack | questions forums | excel questions | col 10 | 2400.31011 |
| stack | questions forums | excel questions | col 11 | 642.2459256 |
| stack | questions forums | excel questions | col 12 | 5573.176935 |
| stack | questions forums | excel questions | col 13 | -19167.60096 |
| stack | questions forums | excel questions | col 14 | -17070.78503 |
| stack | questions forums | excel questions | col 15 | 2884.343252 |
| stack | questions forums | excel questions | col 16 | 2262.2904 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -4866.524221 |
| stack | questions forums | excel questions | col 21 | -5470.616311 |
| stack | questions forums | excel questions | col 22 | 6722.889306 |
| stack | questions forums | excel questions | col 23 | -6749.153327 |
| stack | questions forums | excel questions | col 24 | 8483.707603 |
| stack | questions forums | excel questions | col 25 | 7513.052842 |
| stack | questions forums | excel questions | col 26 | 3768.659869 |
| stack | questions forums | excel questions | col 27 | 8600.703543 |
| stack | questions forums | excel questions | col 28 | -8642.799155 |
| stack | questions forums | excel questions | col 29 | 1322.251923 |
| stack | questions forums | excel questions | col 30 | -1323.911031 |
| stack | questions forums | excel questions | col 31 | 3651.739593 |
| stack | questions forums | excel questions | col 32 | -259.3401823 |
| stack | questions forums | excel questions | col 33 | 9369.890794 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -325.5117945 |
| stack | questions forums | excel questions | col 5 | 641.8568521 |
| stack | questions forums | excel questions | col 6 | -58.21010305 |
| stack | questions forums | excel questions | col 7 | 977.4626836 |
| stack | questions forums | excel questions | col 8 | -3505.695779 |
| stack | questions forums | excel questions | col 9 | -7455.410001 |
| stack | questions forums | excel questions | col 10 | 777.9341271 |
| stack | questions forums | excel questions | col 11 | 385.2714806 |
| stack | questions forums | excel questions | col 12 | 1932.531773 |
| stack | questions forums | excel questions | col 13 | -8861.136183 |
| stack | questions forums | excel questions | col 14 | -6679.463121 |
| stack | questions forums | excel questions | col 15 | 1177.775583 |
| stack | questions forums | excel questions | col 16 | 881.2548725 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -1813.822794 |
| stack | questions forums | excel questions | col 21 | -2266.860562 |
| stack | questions forums | excel questions | col 22 | 2278.669772 |
| stack | questions forums | excel questions | col 23 | -2361.758467 |
| stack | questions forums | excel questions | col 24 | 3356.446385 |
| stack | questions forums | excel questions | col 25 | 2741.992369 |
| stack | questions forums | excel questions | col 26 | 1461.950204 |
| stack | questions forums | excel questions | col 27 | 3289.154294 |
| stack | questions forums | excel questions | col 28 | -3469.10217 |
| stack | questions forums | excel questions | col 29 | 804.7989704 |
| stack | questions forums | excel questions | col 30 | -816.9003551 |
| stack | questions forums | excel questions | col 31 | 1907.515323 |
| stack | questions forums | excel questions | col 32 | 432.8435868 |
| stack | questions forums | excel questions | col 33 | 3074.256129 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -36.42618332 |
| stack | questions forums | excel questions | col 5 | 65.26139258 |
| stack | questions forums | excel questions | col 6 | -6.513963305 |
| stack | questions forums | excel questions | col 7 | 99.38442773 |
| stack | questions forums | excel questions | col 8 | -435.0485137 |
| stack | questions forums | excel questions | col 9 | -1047.099199 |
| stack | questions forums | excel questions | col 10 | 79.09717611 |
| stack | questions forums | excel questions | col 11 | 39.17283622 |
| stack | questions forums | excel questions | col 12 | 186.7060257 |
| stack | questions forums | excel questions | col 13 | -1272.372107 |
| stack | questions forums | excel questions | col 14 | -922.750792 |
| stack | questions forums | excel questions | col 15 | 118.3261869 |
| stack | questions forums | excel questions | col 16 | 89.60240903 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -210.3183182 |
| stack | questions forums | excel questions | col 21 | -267.1376584 |
| stack | questions forums | excel questions | col 22 | 214.6223869 |
| stack | questions forums | excel questions | col 23 | -280.0000537 |
| stack | questions forums | excel questions | col 24 | 293.4738136 |
| stack | questions forums | excel questions | col 25 | 248.5196226 |
| stack | questions forums | excel questions | col 26 | 144.0720039 |
| stack | questions forums | excel questions | col 27 | 288.5506437 |
| stack | questions forums | excel questions | col 28 | -430.0886416 |
| stack | questions forums | excel questions | col 29 | 81.82868405 |
| stack | questions forums | excel questions | col 30 | -91.41469707 |
| stack | questions forums | excel questions | col 31 | 184.4395708 |
| stack | questions forums | excel questions | col 32 | 44.00977438 |
| stack | questions forums | excel questions | col 33 | 272.8284368 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
| stack | questions forums | excel questions | col 4 | -582.3647427 |
| stack | questions forums | excel questions | col 5 | 1316.573479 |
| stack | questions forums | excel questions | col 6 | -165.4555206 |
| stack | questions forums | excel questions | col 7 | 1925.519573 |
| stack | questions forums | excel questions | col 8 | -7138.977944 |
| stack | questions forums | excel questions | col 9 | -17532.94829 |
| stack | questions forums | excel questions | col 10 | 1404.004642 |
| stack | questions forums | excel questions | col 11 | 930.6126154 |
| stack | questions forums | excel questions | col 12 | 3648.013625 |
| stack | questions forums | excel questions | col 13 | -19585.55834 |
| stack | questions forums | excel questions | col 14 | -13758.8035 |
| stack | questions forums | excel questions | col 15 | 2376.319408 |
| stack | questions forums | excel questions | col 16 | 1898.9449 |
| stack | questions forums | excel questions | col 17 | 0 |
| stack | questions forums | excel questions | col 18 | 0 |
| stack | questions forums | excel questions | col 19 | 0 |
| stack | questions forums | excel questions | col 20 | -3625.886962 |
| stack | questions forums | excel questions | col 21 | -4833.808881 |
| stack | questions forums | excel questions | col 22 | 4232.764078 |
| stack | questions forums | excel questions | col 23 | -4449.956081 |
| stack | questions forums | excel questions | col 24 | 6883.584715 |
| stack | questions forums | excel questions | col 25 | 5398.12044 |
| stack | questions forums | excel questions | col 26 | 4048.773452 |
| stack | questions forums | excel questions | col 27 | 6632.405148 |
| stack | questions forums | excel questions | col 28 | -7240.871663 |
| stack | questions forums | excel questions | col 29 | 1959.676076 |
| stack | questions forums | excel questions | col 30 | -2008.657583 |
| stack | questions forums | excel questions | col 31 | 4413.431721 |
| stack | questions forums | excel questions | col 32 | 1360.661107 |
| stack | questions forums | excel questions | col 33 | 5484.849776 |
| stack | questions forums | excel questions | col 34 | 0 |
| stack | questions forums | excel questions | col 35 | 0 |
| stack | questions forums | excel questions | col 36 | 0 |
| stack | questions forums | excel questions | col 37 | 0 |
| stack | questions forums | excel questions | col 38 | 0 |
| stack | questions forums | excel questions | col 39 | 0 |
| stack | questions forums | excel questions | col 40 | 0 |
| stack | questions forums | excel questions | col 41 | 0 |
| stack | questions forums | excel questions | col 42 | 0 |
| stack | questions forums | excel questions | col 43 | 0 |
| stack | questions forums | excel questions | col 44 | 0 |
| stack | questions forums | excel questions | col 45 | 0 |
| stack | questions forums | excel questions | col 46 | 0 |
| stack | questions forums | excel questions | col 47 | 0 |
| stack | questions forums | excel questions | col 48 | 0 |
| stack | questions forums | excel questions | col 49 | 0 |
+---------+------------------+-----------------+-----------+--------------+回答 2
Stack Overflow用户
回答已采纳
发布于 2018-07-05 10:41:39
抱歉，但我不想分析你的代码甚至出于某种原因使用它.
首先，编程中的一个常见错误是使用未指定的(未声明的)变量。这会导致几个问题，特别是当程序员犯了拼写错误(输入错误)时，例如，他没有使用myvariable，而是使用了myvairable。所以..。
强烈建议使用选项显式语句，因为..。如MSDN文档所述：
如果不指定数据类型，默认情况下将分配
Variant数据类型。 (...)Variant类型的变量比大多数其他变量需要更多的内存资源。 (...) 如果模块包含Option Explicit语句，则当Visual遇到以前未声明的变量名或拼写错误时，将发生编译时错误。
详情请见：
Office Talk:在Office 2010的32位和64位版本中使用VBA
第二，当您试图执行超出分配目标限制的赋值时，会发生溢出错误。这个错误可能是Excel崩溃的原因。
第三，在所有中，您应该在上下文中使用代码。代码的非上下文使用可能是导致数据丢失等几个问题的原因。
想象一下:有两个打开的工作簿。它们都有一组相同的工作表：Sheet1、Sheet2和Sheet3。当您使用Sheets("Sheet1").Range("A1") = "whatever"时，在活动工作簿中进行更改，比如Workbook1，但是您希望在Workbook2中进行更改。明白了?
顺便说一句，Sheet和Worksheet不一样
因此，在上下文中使用代码的正确方法是：
Dim srcWsh As Worksheet
Dim trgWsh As Worksheet
Set srcWsh = ThisWorkbook.Worksheets("Sheet1") 'you can use index too, see:
Set trgWsh = Workbooks("Workbook2").Worksheets(2)
trgWsh.Range("A1") = srcWsh.Range("A1")
'finally, you have to clean up
Set srcWsh = Nothing
Set trgWsh = Nothing在创建或调用程序或职能时必须使用相同的规则
终于.
关于逆转数据的方法.
我确实使用了MSDN：使用枢轴和UNPIVOT中的一个示例，其中有以下数据：
VendorID Emp1 Emp2 Emp3 Emp4 Emp5
1 4 3 5 4 4
2 4 1 5 5 5
3 4 3 5 4 4
4 4 2 5 5 4
5 5 1 5 5 5必须“转换”成以下表格：
VendorID Employee Orders
----------- ----------- ------
1 Emp1 4
1 Emp2 3
1 Emp3 5
1 Emp4 4
1 Emp5 4
2 Emp1 4
2 Emp2 1
2 Emp3 5
2 Emp4 5
2 Emp5 5
...我的代码：
Option Explicit
Sub Test()
UnpivotData ThisWorkbook.Worksheets("Arkusz1"), _
ThisWorkbook.Worksheets("Arkusz2"), _
"A1", "B1:F1"
End Sub
Sub UnpivotData(ByVal srcWsh As Worksheet, ByVal trgWsh As Worksheet, ByVal unpvtFor As String, ByVal pivotedColumns As String, _
Optional ByVal commonHeader As String = "Employee", Optional ByVal pvtValuesToCol As String = "Orders")
'declare variables
Dim lastrow As Long, r As Long, trgr As Long
Dim c As Long, cName As String
'on error go to error handler
On Error GoTo Err_UnpivotData
'find last row
lastrow = srcWsh.UsedRange.Rows.Count
'context!
With trgWsh
'clear
.Cells.Clear
'add headers
.Range("A1") = srcWsh.Range(unpvtFor)
.Range("B1") = commonHeader
.Range("C1") = pvtValuesToCol
'"convert" values
r = 1
trgr = 0
'loop through the collection of rows in srcWsh
Do While r < lastrow
'loop through the collection of pivoted columns in srcWsh
For c = 0 To srcWsh.Range(pivotedColumns).Columns.Count - 1
'unpivot value of 1. column
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=0) = srcWsh.Range(unpvtFor).Offset(RowOffset:=r, ColumnOffset:=0)
'unpivot header
cName = srcWsh.Range(pivotedColumns).Columns(c + 1).Address
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=1) = srcWsh.Range(cName).Rows(1)
'unpivot value
.Range("A2").Offset(RowOffset:=trgr, ColumnOffset:=2) = srcWsh.Range(unpvtFor).Offset(RowOffset:=r, ColumnOffset:=c + 1)
'increase target counter
trgr = trgr + 1
Next
'increase source counter
r = r + 1
Loop
End With
Exit_UnpivotData:
On Error Resume Next
'clean up
Exit Sub
Err_UnpivotData:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_UnpivotData
End Sub随时可以根据你的需要.
工作示例：Unpivot.7z -可在中欧(华沙)时间上午7时01分至晚上11时59分之间下载
我希望我已经详细解释了你的代码出了什么问题。
编辑
假设数据在Sheet1中，目标表是Sheet2.
Option Explicit
Sub Test()
UnpivotData ThisWorkbook.Worksheets("Sheet1"), _
ThisWorkbook.Worksheets("Sheet2"), _
"A1:C1", "D1:AW1"
End Sub
Sub UnpivotData(ByVal srcWsh As Worksheet, ByVal trgWsh As Worksheet, ByVal unpvtFor As String, ByVal pivotedColumns As String, _
Optional ByVal commonHeader As String = "Attribute", Optional ByVal pvtValuesToCol As String = "Value")
'declare variables
Dim lastrow As Long, r As Long, trgr As Long
Dim c As Long, cName As String
Dim cc As Range
'on error go to error handler
On Error GoTo Err_UnpivotData
'change settings to improve speed of macro executing
Application.EnableEvents = False
Application.ScreenUpdating = False
'find last row
lastrow = srcWsh.UsedRange.Rows.Count
'context!
With trgWsh
'clear
.Cells.Clear
'add headers
For Each cc In srcWsh.Range(unpvtFor).Cells
.Range("A1").Offset(ColumnOffset:=c) = Trim(cc)
c = c + 1
Next
Set cc = .Range("A2").Offset(ColumnOffset:=c)
.Range("A1").Offset(ColumnOffset:=c) = commonHeader
c = c + 1
.Range("A1").Offset(ColumnOffset:=c) = pvtValuesToCol
'"convert" values
r = 1
trgr = 0
'loop through the collection of rows in srcWsh
Do While r < lastrow
'loop through the collection of pivoted columns in srcWsh
For c = 0 To srcWsh.Range(pivotedColumns).Columns.Count - 1
'copy original data
srcWsh.Range(unpvtFor).Offset(RowOffset:=r).Copy .Range("A2").Offset(RowOffset:=trgr)
'unpivot data - attribute
cName = srcWsh.Range(pivotedColumns).Columns(c + 1).Address
cc.Offset(RowOffset:=trgr, ColumnOffset:=0) = Trim(srcWsh.Range(cName).Rows(1))
'unpivot data - value
cc.Offset(RowOffset:=trgr, ColumnOffset:=1) = Trim(srcWsh.Range(cName).Offset(RowOffset:=r))
'increase target counter
trgr = trgr + 1
Next
'increase source counter
r = r + 1
Loop
End With
Exit_UnpivotData:
On Error Resume Next
'clean up
Set cc = Nothing
'restore previous settings
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
Err_UnpivotData:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_UnpivotData
End Sub祝好运!
Stack Overflow用户
发布于 2018-07-04 06:26:41
试试这个：
Sub Unpivot()
Call ReversePivotTable("Sheet1", "A", "C", "Sheet2", "Name")
End Sub
Sub ReversePivotTable(source_sheet, from_col, to_col, target_sheet, Optional type_header = "type", Optional value_header = "value")
Application.ScreenUpdating = False
LAST_ROW = Sheets(source_sheet).Cells(Rows.Count, 1).End(xlUp).Row
If LAST_ROW > 1 Then
Sheets(target_sheet).Cells.ClearContents
Else
Exit Sub
End If
pvt_type_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 1).Column 'D
pvt_value_col = Sheets(target_sheet).Range(to_col & 1).Offset(0, 2).Column 'E
'get headers
Sheets(source_sheet).Range(from_col & ":" & to_col).Copy
Sheets(target_sheet).Range("A1").PasteSpecial xlPasteValues
Sheets(target_sheet).Cells(1, pvt_type_col).Value = type_header
Sheets(target_sheet).Cells(1, pvt_value_col).Value = value_header
'tranform data
curr_row = 2
With Sheets(source_sheet)
last_col = .Cells(1, Columns.Count).End(xlToLeft).Column
For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
Set Rng = .Range(.Cells(c.Row, pvt_type_col), .Cells(c.Row, last_col))
numbers = Application.WorksheetFunction.CountIf(Rng, "<>""")
If numbers > 0 Then
Sheets(target_sheet).Range(from_col & curr_row & ":" & from_col & curr_row + numbers - 1).Value = Sheets(source_sheet).Range(from_col & c.Row & ":" & to_col & c.Row).Value
Application.CutCopyMode = False
b = curr_row
For a = pvt_type_col To last_col Step 1
If IsNumeric(.Cells(c.Row, a).Value) Then
'If .Cells(c.Row, a).Value <> "" Then
Sheets(target_sheet).Cells(b, pvt_type_col) = .Cells(1, a)
Sheets(target_sheet).Cells(b, pvt_value_col) = .Cells(c.Row, a)
b = b + 1
End If
Next a
curr_row = curr_row + numbers
If curr_row Mod 10 = 0 Then DoEvents
End If
Next c
End With
Sheets(target_sheet).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/50571628
复制相关文章
相似问题
腾讯云开发者
Copyright © 2013 - 2026 Tencent Cloud. All Rights Reserved. 腾讯云 版权所有
深圳市腾讯计算机系统有限公司 ICP备案/许可证号：粤B2-20090059 
粤公网安备44030502008569号
腾讯云计算（北京）有限责任公司 京ICP证150476号 | 京ICP备11018762号