使用集合和崩溃Mac 2016 Excel

Question

我正在使用VBA脚本根据某列中的单元格是否与预定义的字符串列表（制造商名称）匹配来自动删除Excel中不同数据集的行。每次数据集的数量可能会有所不同，并且要检查的列在每个数据集中都会有所不同。有一个设置页面，用户在其中定义包含数据集的工作表，要检查每个数据集的列中的第一个单元格以及要检查的字符串列表，这些都被称为定义的命名范围。

我的宏似乎工作，但最终崩溃的Excel。 5年左右我还没有做过任何VBA编程。任何帮助，将不胜感激！

Private Sub RemoveManufacturers() 

Application.Calculation = xlCalculationManual 

Dim source As New Collection 
Dim manufacturer As New Collection 
Dim manufacturer_col As New Collection 
Dim key As Variant 
Dim i As Integer 
Dim j As Integer 
Dim flg As Boolean 


ActiveWorkbook.Sheets("settings").Activate 

'Add Manufacturer Names to Collection 

For Each key In Range("manufacturers").Cells 
    manufacturer.Add key.Value 
Next 

'Add Manufacturer Column Refs to manufacturer_col Collection 

For Each key In Range("manufacturer_cols").Cells 
    manufacturer_col.Add key.Value 
Next 

'Add User Defined sheetnames to source Collection 

For Each key In Range("source").Cells 
    source.Add key.Value  
Next 

'Define number of iterations based on raw datasets 
i = source.Count 

'Loop through Raw Data Sheets 
Do Until i = 0 

    'Add use sheet names to navigate to relevant worksheets 
    ActiveWorkbook.Sheets(source(i)).Activate 
    Application.ScreenUpdating = False 

     'Select column with data in 
     Range(manufacturer_col(i)).Select 

     'Loop through column until a blank cell is found 
     Do Until ActiveCell.Value = "" 
      'Define number of iterations based on no. of manufacturers 
      j = manufacturer.Count 
      flg = False 

      'Loop through each Manufacturer name 
      Do Until j = 0 
       'If match found set Flag to True 

       If InStr(ActiveCell.Value, UCase(manufacturer(j))) <> 0 Then 
        flg = True 
        'Get out of loop 
        GoTo IgnoreOrDelete 
       End If 
       'increment counter 
       j = j - 1 
      Loop 
IgnoreOrDelete: 
      'If Flag has been set 
      If flg = True Then 
       ActiveCell.Offset(rowOffset:=1).Activate 
      Else 
       ActiveCell.EntireRow.Delete 
      End If 
     Loop 

    i = i - 1 
    Application.ScreenUpdating = True 
Loop 

End Sub 

Answer 1

如果您尝试将key.Value添加到已存在的集合中，它将会崩溃。

我怀疑这很有可能是你的问题。但是我无法确定仅基于您的代码。

如果你的罚款与集合只包含每个独特商品的一个实例，你可以添加“上的错误继续下一步”，如下：

On Error Resume Next 

如果你有这个错误不精，并要处理它在一些其他的方式，请做一些这样的：

'Add Manufacturer Names to Collection 
On Error Goto NameDup: 
For Each key In Range("manufacturers").Cells 
    manufacturer.Add key.Value 
Next 
if false then 
NameDup: 
    'Your code here 
end if 

'Add Manufacturer Column Refs to manufacturer_col Collection 
On Error Goto ColDup: 
For Each key In Range("manufacturer_cols").Cells 
    manufacturer_col.Add key.Value 
Next 
if false then 
ColDup: 
    'Your code here 
end if 

'Add User Defined sheetnames to source Collection 
On Error Goto SourceDup: 
For Each key In Range("source").Cells 
    source.Add key.Value  
Next 
if false then 
SourceDup: 
    'Your code here 
end i 

'Reset error handler 
On Error Goto 0