Excel 宏将数百列转为仅 3

Question

我收到包含数百列的每周报告。这些列是针对每周的，并包含两个度量子列（销售额、销售量）。

我想将这些列仅转换为 4：客户名称、周、销售额、销售单位。我已经成功编写了一个宏来执行此操作，并且它最初运行得非常快，但因为运行 非常 很慢。我认为唯一发生的变化是我的 IT 部门更新了我的 Excel 365 版本。

如果我有这些数据：

Client Name | Week 1 Sales | Week 1 Units | Week 2 Sales | Week 2 Units ...
___________________________________________________________________________

    ABC Co  | 100,000      | 10           | 150,000      | 21        ...

我想把它转换成这个：

   Client Name |  Week  | Sales   | Units
   ______________________________________

    ABC Co     | Week 1 | 100,000 | 10

    ABC Co     | Week 2 | 150,000 | 21

等

numCols = Application.WorksheetFunction.CountA(dataSh.Range("1:1"))
numRows = Application.WorksheetFunction.CountA(dataSh.Range("A:A")) + 1

For i = 3 To numRows
    For j = 2 To numCols Step 2
        If dataSh.Cells(i, j) <> "" Then

            pivotStartRng.Offset(matches, 0) = dataSh.Cells(i, 1)
            pivotStartRng.Offset(matches, 1) = dataSh.Cells(1, j)
            pivotStartRng.Offset(matches, 2) = dataSh.Cells(i, j)
            pivotStartRng.Offset(matches, 3) = dataSh.Cells(i, j + 1)

            matches = matches + 1

        End If

    Next j

Next i

代码的主体查看报告数据的每个单元格，如果它不是空白的，它会将这些结果复制到合并数据选项卡中。它循环通过大约 15,000 个单元格（150 列 x 100 行）。

我还尝试了一种代码，该代码基本上将每一列复制并粘贴到数据表中，然后删除了空白行。但这也运行得很慢。

我的问题是，这种循环通过 15,000 个单元的宏是否总是运行缓慢，或者这不是挂断的问题？也就是说，以不同的方式编写宏会更好吗？

更新我今天早上运行了原始代码，它运行得非常快。我粘贴到的范围是一个表格，左侧有查找公式，在粘贴数据时复制行。似乎这大大减慢了速度，当我移除表格并运行宏时，它运行得非常快。我不确定粘贴到 Excel 中的表格是否会导致它运行如此缓慢，或者是否还有其他事情发生？

Answer 1

将所有数据加载到变体数组中，循环该数组并加载另一个变体数组，然后将变体数组发布到新工作表上。限制 vba 引用工作表上数据的次数。

numcols = Application.WorksheetFunction.CountA(dataSh.Range("1:1"))
numrows = Application.WorksheetFunction.CountA(dataSh.Range("A:A")) + 1

Dim dat As Variant
dat = dataSh.Range(dataSh.Cells(3, 2), dataSh.Cells(numrows, numcols)).Value

Dim odat As Variant
ReDim odat(1 To ((UBound(dat, 2) - 1) / 2) * UBound(dat, 1), 1 To 4)

matches = 1

For I = LBound(dat, 1) To UBound(dat, 2)
    For J = LBound(dat, 2) + 1 To UBound(dat, 2) Step 2
        If dat(I, J) <> "" Then

            odat(matches, 1) = dat(I, 1)
            odat(matches, 2) = dat(1, J)
            odat(matches, 3) = dat(I, J)
            odat(matches, 4) = dat(I, J + 1)

            matches = matches + 1

        End If

    Next J

Next I

pivotStartRng.Resize(UBound(odat, 1), 4).Value = odat