Question

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

我想将这些列仅转换为4：客户名称，周，销售额，销售单位。我已经成功编写了一个宏来执行此操作，它最初运行得非常快，但是自 extremely 运行以来一直很慢。我认为发生的唯一变化是我的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

Excel宏可将数百列透视为仅3

1 个答案: