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