Excel VBA,数据转换导致Excel崩溃。

3
我有一段代码会导致我的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 |
+---------+------------------+-----------------+-----------+--------------+

1
如果您只需要进行透视/反透视操作,请尝试使用 Power Query。 - QHarr
1
从Excel范围中阅读有关VBA数组的内容。或者至少不要复制粘贴,而是将单元格之间的值进行传递。 - Ryszard Jędraszyk
1
如果你想优化代码,可以在 https://codereview.stackexchange.com/ 上寻求帮助,或者在 StackOverflow 上询问如何处理代码的特定部分。 - Ryszard Jędraszyk
@MaciejLos,是的,next c循环导致了崩溃。我猜测是转换数据部分中的巨大循环引起的。 - excelguy
1
如果不了解“sheet1”和“sheet2”上的基本布局,阅读并根据您的确切需求优化代码将变得非常困难甚至不可能。 - Taylor Alex Raine
显示剩余10条评论
2个回答

7
抱歉,但我不想为一系列原因分析您的代码甚至使用它... 首先,在VBA编程中常见的错误是使用未指定(未声明)的变量。这会引起多种问题,特别是当程序员出现拼写错误(打字错误)时,例如,他使用了myvairable而不是myvariable。因此...强烈建议使用Option Explicit语句,因为...正如MSDN文档所述: 如果您没有指定数据类型,则默认情况下将分配Variant数据类型。 (...) Variant类型的变量需要比大多数其他变量更多的内存资源 (...) 如果模块包含Option Explicit语句,则在Visual Basic遇到以前未声明或拼写不正确的变量名时会发生编译时错误。
有关详细信息,请参见: Wikipedia:Visual Basic for Applications VBA:声明变量 运行时与编译时 Office Talk:在Office 2010的32位和64位版本中使用VBA 其次,当您尝试进行超出分配目标限制的赋值时,会发生溢出错误。该错误可能是Excel崩溃的原因。

第三点,您应该在上下文中使用代码。非上下文的代码使用可能会导致多种问题,例如数据丢失。
想象一下:有两个打开的工作簿。它们都有相同的工作表集合:Sheet1Sheet2Sheet3。当您使用Sheets("Sheet1").Range("A1") = "whatever"时,更改是在活动工作簿中进行的,比如说Workbook1,但是您想要在Workbook2中进行更改。明白了吗?
顺便说一下:请注意,SheetWorksheet不同。
SheetsWorksheets
因此,正确使用代码上下文的方法是:

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

创建或调用过程或函数时必须使用相同的规则。

最后...
至于反转(unpivot)数据的方法...
我使用了 MSDN 的一个示例:使用 PIVOT 和 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

祝你好运!


你尝试过根据自己的需求更改我的代码吗?你卡在哪里了?我认为我的代码(带有注释)相当易懂...但是,如果你需要帮助,我可以帮助你。创建新的聊天并邀请我加入。 - Maciej Los
谢谢,我马上测试一下。顺便问一下,“Attribute”,“Value”和“D1:AW1”是什么?我很难弄清楚我的值应该放在哪里。 - excelguy
@excelguy,请下载unpivot.xlsm文件。'D1:AW1'是将数据逆转为“属性”和“值”的标题地址。 - Maciej Los
我在下载表格时遇到了麻烦,电脑不允许下载。 - excelguy
我有其他在事件中被调用的宏,我需要全部禁用还是只需要在这个子程序中禁用?你能在回答中给我展示一下吗? - excelguy
显示剩余6条评论

0

试试这个:

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

谢谢您的回复。在数据转换部分的“Next c”部分,我仍然遇到了Excel无响应的问题。 - excelguy
1
我实际上创建了样本数据并检查了你原始的代码和我展示的版本。你的代码完成时间很长 - 可能较慢的机器会崩溃。然而,纠正后的版本 - 在其中我将值分配给单元格而不是复制它们 - 是非常快的(我已经创建了45k行的样本数据)。如果可能的话,请展示一个你用这个宏的实际数据的例子。 - Pawel Czyz
我可以给您发送一个样品表格吗?您能在聊天中给我发消息吗? - excelguy

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接