Excel的VBA用尽了资源 [英] VBA for Excel is running out of resources

问题描述

我有一个excel工作表，我需要根据一列的值分成几个较小的工作表。代码运行良好，但当它超过行10k时，资源耗尽。

I have an excel worksheet that I need to divide up into several smaller worksheets based upon the value of one column. The code works great, but runs out of resources when it gets past row 10k.

我认为问题是当我试图找到最后一行，所以我想知道是否有一个更有效的解决方法来避免内存问题。或者也许这不是问题吗？

I think that the problem is when I'm trying to find the last row, so I was wondering if there was a more efficient workaround to avoid the memory problem. Or perhaps this isn't the problem anyway?

代码如下。

Sub Fill_Cells()

Dim masterSheet As Worksheet
Dim masterSheetName As String
Dim TRRoom As String, tabName As String

Dim lastRowNumber As Long
Dim j As Long

Application.ScreenUpdating = False

masterSheetName = "Master"

Set masterSheet = Worksheets(masterSheetName)

lastRowNumber = masterSheet.Cells.Find("*", SearchOrder:=xlByRows,      SearchDirection:=xlPrevious).Row

j = 4

For Each c In masterSheet.Range("AB4:AB" & lastRowNumber).Cells

  TRRoom = c.Value
  tabName = "TR-" & TRRoom
  localLastRowNumber = Worksheets(tabName).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  insertRow = localLastRowNumber + 1

Worksheets(tabName).Rows(insertRow).Value = masterSheet.Rows(j).Value

j = j + 1

Next

End Sub

如果有人可以帮助我，我会很感激。

If anyone could help me with this, I would appreciate it.

推荐答案

我建议使用ADODB Connection和SQL语句来读取和写入工作表。将Excel文件作为数据库处理通常比使用Excel Automation API要快得多。

I would suggest using an ADODB Connection, and SQL statements to read from and write to the worksheets. Treating the Excel file as a database is generally much faster than working through the Excel Automation API.

添加对。那么下面的代码将会给你一个当前工作簿的连接：

Add a reference to Microsoft ActiveX Data Objects 2.8 Library. Then the following code will give you a connection to the current workbook:

Dim conn As New Connection
With conn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=""" & ActiveWorkbook.FullName & """;" & _
        "Extended Properties=""Excel 12.0;HDR=No;"""
    'If you're running a version of Excel earlier than 2007, the connection string should look like this:
    '.ConnectionString = "Data Source=""" & ActiveWorkbook.FullName & """;" & _
    '    "Extended Properties=""Excel 8.0;HDR=No;"""
    .Open
End With

然后，您可以获得唯一的TRRoom的列表：

Then, you can get a list of unique TRRooms:

Dim rs As Recordset
Set rs = conn.Execute("SELECT DISTINCT F28 FROM [Master$]")
'Field F28, because if you specify that your range does not have header rows (HDR=No 
'in the connection string) ADODB will automatically assign field names for each field
'Column AB is the 28th column in the worksheet

并将相关行插入到相应的工作表中：

and insert the relevant rows into the appropriate worksheet:

Do Until rs.EOF
    Dim trroom As String
    trroom = rs!F28
    conn.Execute _
        "INSERT INTO [TR-" & trroom & "$] " & _
        "SELECT * " & _
        "FROM [Master$] " & _
        "WHERE F28 = """ & trroom & """"
    rs.MoveNext
Loop

请参阅此处有关ADODB的一些参考。

See here for some references about ADODB.

这篇关于Excel的VBA用尽了资源的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！