Arrays VBA-Excel大数据操作耗时长

我有两个excel文件

第一个excel文件包含人名和当前总天数列 前

另一个excel文件包含人员姓名、日期和状态（出席/缺席）

我需要将相似的日期状态分组为一个，并计算它们以在第一个excel文件中更新

我在第一个文件中有大约100行，在第二个文件中有20000行需要检查。为了加快计算速度，我将第二个文件中的所有行加载到一个数组中，并读取它们以计算每个正确工作的条目

问题是，它占用了大量内存，所以在Windows中，许多应用程序自动打开，系统几乎挂起

是否有任何替代方案可以在没有内存问题和快速处理的情况下实现此功能。我遇到了脚本。字典，但不确定它是否会占用更少的内存

编辑 我尝试过使用redimpreserve和大小为20000的静态数组，在这两种情况下都会出现相同的问题

编辑

lblStatus.Caption = "Loading to memory"
 Dim ArrAuditData() As AData
 Dim TotalLookUpCount As Integer
 For J = 1 To 50000

 If lookUpRange.Cells(J, cmbChoice.ListIndex) = "Fail" Then
  ReDim Preserve ArrAuditData(J) As AData
    ArrAuditData(TotalLookUpCount).AuditType = lookUpRange.Cells(J, cmdAudit2.ListIndex)
    ArrAuditData(TotalLookUpCount).TransTime = lookUpRange.Cells(J, cmbChoice.ListIndex - 1)
    ArrAuditData(TotalLookUpCount).AuditValue = lookUpRange.Cells(J, cmbChoice.ListIndex)
    ArrAuditData(TotalLookUpCount).Slno = lookUpRange.Cells(J, 0)

    TotalLookUpCount = TotalLookUpCount + 1
ElseIf lookUpRange.Cells(J, cmbChoice.ListIndex) = "" And J > 4 Then Exit For

    End If
    DoEvents
  Next

---

包含4个变体的20000个元素的阵列将占用不到2MB的RAM。我不认为内存与你的问题有任何关系，除非你使用的是一台内存为2MB的旧电脑或类似的东西

代码如此繁重的一个更可能的原因是在单元格中循环。VBA和Excel工作表数据之间的每次通信都有很大的开销，当您一次引用多个单元格时，这会增加开销。在您的情况下，循环最多执行200000个单独的单元格引用

相反，您应该一次将所有数据加载到

Variant

数组中，然后在该数组中循环，如下所示。这要快得多（尽管这会占用更多的内存，而不是更少的内存；但是，我认为内存不是你的问题）

为了进一步阅读，请阅读这篇古老但仍然相关的文章：

如果您仍然认为RAM是问题所在，那么请向我们展示

AData

类型声明

---

编辑：另外，决不要在这样的循环中重新编辑

ReDim Preserve

是一项非常昂贵的操作，几乎不需要在任何给定阵列上执行多次。做20000次会降低代码的速度。在这里，我将它从循环中取出，并在末尾使用它一次，以修剪掉未使用的元素。（请注意我最初是如何将数组重新定义为可以容纳的最大数量的元素的。）

我建议采用不同的方法

如果我对问题的解释正确：

• 您希望获得每个人“出席”或“缺席”的天数
• 第一个文件（称为file1）每人包含一行（约100人）
• 第二个文件（称为file2）每人每天包含一行（100人和200天=20000行）
• 所需的输出是文件1中的两个额外列，即“存在”和“不存在”的计数

我将使用的方法是使用COUNTIF（或者如果您使用Excel 2007或更高版本的COUNTIF）

假定

• 文件1在Sheet1上包含一个名为StatusReport的表，列a=名称，B=存在，C=不存在
• 每个唯一名称对应一行
• 文件2在Sheet1上包含一个名为StatusData的表，列a=名称，B=日期，C=状态
• 每个日期的每个名称对应一行

Excel 2007或2010解决方案

• file1单元B2
  

  =COUNTIFS（file2.xlsx！StatusData[Name]，[Name]，file2.xlsx！StatusData[Status]，StatusReport[[Headers]，[Present]]）

• 文件1单元C2
  

  =COUNTIFS（file2.xlsx！StatusData[Name]，[Name]，file2.xlsx！StatusData[Status]，StatusReport[[Headers]，[缺席]]）

Excel 2003解决方案

• 在file2 StatusData表中添加一个额外的列D（称为代码）
  

  =Sheet1$A2&“_u”和表1$C2

• file1单元B2
  

  =COUNTIF（[file2.xls]Sheet1！$D:$D，Sheet2！$A2&“&Sheet2！$B$1）

• 文件1单元C2
  

  =COUNTIF（[file2.xls]Sheet1！$D:$D，Sheet2！$A2&“&Sheet2！$C$1）

---

注意：虽然这些公式给出了相同的结果，但COUNTIFS+表引用了2010年的版本，如果速度快得多，这并不有趣（我对大约300000行的测试在几秒钟内更新）

你能在你认为问题发生的地方粘贴一个片段吗？单凭描述很难看出你做了什么。另外，你是否有

Application.screenUpdatement=False

？这应该可以节省一些计算量。@jonsca:真的吗？！屏幕上没有任何内容被更改。在这种情况下，

.screenUpdatement=False

是否仍能节省计算量？@Jean-François Corbett在我发表评论时，问题中没有显示代码，因此我不知道程序中到底发生了什么。所以，不，不是针对OP所呈现的情况。我在没有使用redim Preserve的情况下进行了尝试，速度快了一点，但内存问题是相同的。如果我读取每个条目的每个单元格，而不是使用数组，则不会出现内存问题，但需要花费更多的时间，大约10-15分钟。以下是Adata结构“code”公共类型Adata Slno作为字符串AuditType作为字符串TransTime作为字符串AuditValue作为字符串结束类型OK，类型为

String

的4个元素。你的琴弦平均有多长？你们有多少内存可用？我仍然怀疑内存是否是问题所在，除非字符串长得离谱（或者其他应用程序正在耗尽所有RAM）。如果字符串长度为1000个字符，那么20000个元素的数组只能填充80MB。不，字符串最多为20个字符，RAM为2GB。当时没有启动其他程序。它在不同的系统中重复。

PersonName      Date      Status
xyz           1/1/2011    Present
xyz           1/1/2011    Present

lblStatus.Caption = "Loading to memory"
 Dim ArrAuditData() As AData
 Dim TotalLookUpCount As Integer
 For J = 1 To 50000

 If lookUpRange.Cells(J, cmbChoice.ListIndex) = "Fail" Then
  ReDim Preserve ArrAuditData(J) As AData
    ArrAuditData(TotalLookUpCount).AuditType = lookUpRange.Cells(J, cmdAudit2.ListIndex)
    ArrAuditData(TotalLookUpCount).TransTime = lookUpRange.Cells(J, cmbChoice.ListIndex - 1)
    ArrAuditData(TotalLookUpCount).AuditValue = lookUpRange.Cells(J, cmbChoice.ListIndex)
    ArrAuditData(TotalLookUpCount).Slno = lookUpRange.Cells(J, 0)

    TotalLookUpCount = TotalLookUpCount + 1
ElseIf lookUpRange.Cells(J, cmbChoice.ListIndex) = "" And J > 4 Then Exit For

    End If
    DoEvents
  Next

lblStatus.Caption = "Loading to memory"
Dim ArrAuditData() As AData
Dim varTemp As Variant
Dim TotalLookUpCount As Integer

' Load everything into a Variant array. 
varTemp = lookUpRange

ReDim ArrAuditData(1 To UBound(varTemp, 1)) As AData

For J = 1 To UBound(varTemp, 1)

    If varTemp(J, cmbChoice.ListIndex) = "Fail" Then

        ArrAuditData(TotalLookUpCount).AuditType = varTemp(J, cmdAudit2.ListIndex)
        ArrAuditData(TotalLookUpCount).TransTime = varTemp(J, cmbChoice.ListIndex - 1)
        ArrAuditData(TotalLookUpCount).AuditValue = varTemp(J, cmbChoice.ListIndex)
        ArrAuditData(TotalLookUpCount).Slno = varTemp(J, 0)
        TotalLookUpCount = TotalLookUpCount + 1

    ElseIf varTemp(J, cmbChoice.ListIndex) = "" And J > 4 Then
        Exit For

    End If

    DoEvents
Next

ReDim Preserve ArrAuditData(TotalLookUpCount) As AData