VBA例程运行时间太长

huangapple go评论91阅读模式
英文:

VBA routine taking forever to run

问题

以下是您要翻译的内容:

有一个在Oracle中的报告,我将其导出到Excel,但格式非常糟糕。有成千上万个独立账户,每个账户都有一个或多个数据行。我需要对报告进行大量数据处理,使其具有一定的实用性。报告的布局如下("数据行"的行数因每条记录而异)。

标题1
标题2
数据行
数据行
数据行
----------------------
汇总数据
汇总数据

问题在于这些记录无法通过标题来筛选,因为数据是垂直堆叠的。因此,在我剔除了所有不需要的多余行后,每个记录之间留下了一个分隔的空行(这是一种启用退出内部循环的原始方法),我运行了一个我创建的非常简单的VBA例程。对于每个"数据行",标题会打印到同一行的右侧列中。

我将数据分成两个或多个集合,因为可能有超过60,000行,这是为了防止运行时错误"6"。

数据行  标题1  标题2
数据行  标题1  标题2
数据行  标题1  标题2
----------------------
汇总数据
汇总数据

以下例程以前运行速度非常快 - 不到30秒,但现在从Office 2016更改到Office 365桌面版后,相同的例程运行速度非常慢。运行一个段落可能需要半小时。我很困惑。有人能告诉我可能导致这种情况以及我可以对这个例程进行哪些更改以使其运行更快吗?

Sub UnifyRowData()
Dim i As Integer
Dim TtlRows As Integer

TtlRows = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Do Until i > TtlRows
i = i + 1
Heading1 = Cells(i, 1)
Heading2  = Cells(i + 1, 1)
Heading3 = Cells(i + 2, 1)
    Do
    Cells(i, 3).Value = Heading1
    Cells(i, 4).Value = Heading2
    Cells(i, 5).Value = Heading3
    i = i + 1
    Loop Until IsEmpty(Cells(i, 1))
  Loop

End Sub

我不知道我可以做出什么改变。我已经阅读了关于屏幕更新导致长时间运行的问题,但有人需要向我解释为什么这会减慢这个曾经运行得非常快的例程。

英文:

There is a report in Oracle that I dump into Excel but it has terrible formatting. There are thousands of individual accounts and each account has one or more lines of data. I need to do intensive data manipulation on the report to whip it into shape such that there is any utility to it whatsoever. This is the way the report is laid out (the "Rows of data" lines vary for each record).

Header1
Header2
Row of data
Row of data
Row of data
----------------------
summary data
summary data

The problem is that these records can not be filtered by the headers because the data is stacked vertically. So, after I have stripped out all the extraneous rows that I don't want, leaving a delimiting blank row between each record (a primitive method of enabling exiting the inner loop), I run a very simple VBA routine I created. For each 'Row of Data', the headers print to a column to the right on the same row.

I segment the data into two or more sets because there might be over 60K lines and this is to prevent a run time error "6".

Row of data  Header1  Header2
Row of data  Header1  Header2
Row of data  Header1  Header2
----------------------
summary data
summary data 

The following routine used to run at lightening speed - less than 30 seconds, now after a change from Office 2016 to Office 365 desktop, the same routine runs painfully slow. It can take a half hour to run one segment. I am baffled. Can someone tell me what might be causing this and what I can change with this routine to make it run faster?


Sub UnifyRowData()
Dim i As Integer
Dim TtlRows As Integer

TtlRows = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Do Until i > TtlRows
i = i + 1
Heading1 = Cells(i, 1)
Heading2  = Cells(i + 1, 1)
Heading3 = Cells(i + 2, 1)
    Do
    Cells(i, 3).Value = Heading1
    Cells(i, 4).Value = Heading2
    Cells(i, 5).Value = Heading3
    i = i + 1
    Loop Until IsEmpty(Cells(i, 1))
  Loop

End Sub

`

I don't know what I can change. I've read about screen updating causing long run times but someone would need to explain to me why that would slow down this routine that used to run at lightening speed.

答案1

得分: 2

这应该会更快,使用数组处理数据:

Sub UnifyRowData()
    Dim i As Long, ws As Worksheet, h1, h2, h3
    Dim TtlRows As Long, arr, rngData As Range
    
    Set ws = ActiveSheet
    '获取数据范围(包括要填充的附加列)
    Set rngData = ws.Range("A1", ws.Cells(ws.Rows.Count, 1).End(xlUp)).Resize(, 5)
    arr = rngData.Value        '作为数组读取
    TtlRows = UBound(arr, 1)   '数据行数
    
    i = 0
    Do While i <= TtlRows
        i = i + 1
        h1 = arr(i, 1)
        h2 = arr(i + 1, 1)
        h3 = arr(i + 2, 1)
        Do
            arr(i, 3) = h1
            arr(i, 4) = h2
            arr(i, 5) = h3
            i = i + 1
            If i > TtlRows Then GoTo done '如果到达数组末尾,则退出循环
        Loop Until Len(arr(i, 1)) = 0
    Loop
done:
    rngData.Value = arr '将数组写回工作表

End Sub

这是您提供的代码的中文翻译部分。

英文:

This should be faster, using an array to work on the data:

Sub UnifyRowData()
    Dim i As Long, ws As Worksheet, h1, h2, h3
    Dim TtlRows As Long, arr, rngData As Range
    
    Set ws = ActiveSheet
    &#39;get the data range (including additional columns to be populated)
    Set rngData = ws.Range(&quot;A1&quot;, ws.Cells(ws.Rows.Count, 1).End(xlUp)).Resize(, 5)
    arr = rngData.Value        &#39;read as array
    TtlRows = UBound(arr, 1)   &#39;# of rows of data
    
    i = 0
    Do While i &lt;= TtlRows
        i = i + 1
        h1 = arr(i, 1)
        h2 = arr(i + 1, 1)
        h3 = arr(i + 2, 1)
        Do
            arr(i, 3) = h1
            arr(i, 4) = h2
            arr(i, 5) = h3
            i = i + 1
            If i &gt; TtlRows Then Goto done &#39;exit loops if at end of array
        Loop Until Len(arr(i, 1)) = 0
    Loop
done:
    rngData.Value = arr &#39;write the array back to the sheet

End Sub

huangapple
  • 本文由 发表于 2023年1月9日 01:30:27
  • 转载请务必保留本文链接:https://go.coder-hub.com/75049942.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定