Excel VBA优化 - 转置数据

Question

我已经在Excel中以卷起的方式收到了一份报告,我需要将其展平,以便将其导入Access.以下是该行的示例:

需要进行的是客户账户和名称需要转换为与凭证行相邻,并且需要复制,以便每个凭证行都有此信息.转换后,数据应如下所示:

Customer Account |  Name  | Date | Voucher | Invoice | Transation Text | Currency

请注意,以"USD"开头的行表示该客户的记录结束.

我已成功实现以下代码:

Sub Process_Transactions()
'turn off some Excel functionality so code runs faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False 

Dim i As Long
For i = 1 To 731055

    'Move two columns in
    ActiveCell.Offset(0, 2).Select

    'Select the customer account and name
    Range(ActiveCell, ActiveCell.Offset(1, 1)).Select

    'Copy and paste it down two rows and over two columns
    Selection.Cut
    ActiveCell.Offset(2, -2).Select
    ActiveSheet.Paste

    'Hop up a couple rows and delete 3 rows before the data that are not useful
    Rows(ActiveCell.Offset(-2).Row).Select
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp

    'Select the next row
    Rows(ActiveCell.Offset(1).Row).Select

    'If the first record in the row is not "USD", then we have multiple rows for
    'this customer
    While (ActiveCell.Offset(0, 2) <> "USD")
        'Copy and Paste the customer account and number for each
        'transaction row
        ActiveCell.Select
        Range(ActiveCell.Offset(-1, 0), ActiveCell.Offset(-1, 1)).Select
        Selection.Copy
        ActiveCell.Offset(1, 0).Select
        ActiveSheet.Paste
        ActiveCell.Select
        ActiveCell.Offset(1, 0).Select
    Wend

    'Delete the two rows after the data that we need
    ActiveCell.Select
    Rows(ActiveCell.Row).Select
    Selection.Delete Shift:=xlUp
    ActiveCell.Select
    Rows(ActiveCell.Row).Select
    Selection.Delete Shift:=xlUp

    'Move to the next row to start over
    ActiveCell.Select
    Debug.Print "Current Row: " & i
Next i

'at the end, don't forget to restore the default behavior
'calculate the formulas
Application.Calculate
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

问题是该程序非常慢.我让代码昨晚运行了大约10个小时,它只处理了33k.我有大约150万条记录需要处理.

我意识到我正在使用的技术实际上正在移动活动单元,因此删除它可能会有所帮助.但是,我不确定如何继续.如果这是一个失败的原因并且更适合.net实现,请随时提出建议.

Answer 1

您的代码充斥着Excel-VBA方法,效率非常低!我会拍几张照片:

不要使用.Select和Selection..那太慢了.

为什么这样呢

Range(ActiveCell, ActiveCell.Offset(1, 1)).Select
Selection.Cut

当你能做到这一点

Range(ActiveCell, ActiveCell.Offset(1, 1)).Cut

也不要ActiveCell用来移动你的工作表.只需直接在您需要的任何单元格或行上进行操作,例如

Sheet1.Cells(i,2).Copy
Sheet1.Cells(i,1).Paste

实际上,完全避免复制/粘贴,只是说

Sheet1.Cells(i,1).Value = Sheet1.Cells(i,2).Value

避免多次引用同一个对象With而是使用它.这里Sheet1使用了两次,所以你可以这样写:

With Sheet1
    .Cells(i,1).Value = .Cells(i,2).Value
End With

以上只是您必须根据自己的情况调整的示例,还有更多优化,但它们会帮助您入门.清理完代码后,请向我们展示您的代码,并提供更多建议!

Answer 2

快速实现此目的的方法是将大块数据集中到2-D变量数组中

Dim varr as Variant
varr=Worksheets("Sheet1").Range("C5:G10005")

然后循环数组并创建另一个变体2-d数组(varr2)秒,看起来你想要它的方式,然后将变量数组写入另一个工作表:

Worksheets("Sheet2").Range("A2:G2")=varr2