如何从 VBA 集合中删除特定项目？

Question

我一直在尝试创建一个执行此操作的宏：

示例工作表：

1.将“A”、“B”和“C”列分别放入单独的集合中。

2.检查集合'A'项目是否包含“-”。

1. 如果项目包含“-”，则删除所有 3 个集合中具有相同索引的项目。

2. 然后将集合“A”卸载到“D”列中，并根据“B”列和“C”列集合是否相同的索引项值 =“”或不“=”来循环格式化单元格。

初始代码：

1. 创建集合：

    Function ReadRangeRowsToCollection(r As Range) As Collection

        Dim iRow As Long
        Dim iCol As Long
        Dim rangeArr As Variant
        Dim rowArr As Variant
        Dim c As Collection
    
        rangeArr = r.Value
        Set c = New Collection
        For iRow = 1 To r.Rows.Count
            ReDim rowArr(1 To r.Columns.Count)
            For iCol = 1 To r.Columns.Count
                rowArr(iCol) = rangeArr(iRow, iCol)
            Next iCol
            c.Add rowArr, CStr(iRow)
        Next iRow
    
        Set ReadRangeRowsToCollection = c
    End Function

1. 检查集合：

     Dim atid As Collection
       Dim uzdar As Collection
       Dim inv As Collection
        Set inv = ReadRangeRowsToCollection(ws1.Range("A1", ws1.Cells(lRow, "A")))
        Set atid = ReadRangeRowsToCollection(ws1.Range("B1", ws1.Cells(lRow, "B")))
        Set uzdar = ReadRangeRowsToCollection(ws1.Range("C1", ws1.Cells(lRow, "C")))
            Dim i As Integer
            i = inv.Count
            For x = i To 1 Step -1
                 If InStr(CStr(inv.item(x)), "-") > 0 Then
                 inv.Remove x
                 End If
            Next x

遇到的问题：

如果我在集合循环中使用For Each 项目，我不知道在删除集合项目时如何正确循环，集合项目转移到集合顶部，For each 不支持从底部循环。 如果我使用For x= variable to 1 Step-1，我无法正确获取集合项的值并检查它是否包含“-” 我试图将我的“创建收藏”功能更改为：

    Set c = New Collection
        For iRow = 1 To r.Rows.Count
            ReDim rowArr(1 To r.Columns.Count)
            For iCol = 1 To r.Columns.Count
                If Not InStr(rangeArr(iRow, iCol), "-") > 0 Then
                rowArr(iCol) = rangeArr(iRow, iCol)
                Else
                GoTo praleist
                End If
            Next iCol
            c.Add rowArr, CStr(iRow)
    praleist:
        Next iRow

但是，如何从其他集合中删除不需要的项目？

作为一个想法，转储剪切的“A”列集合，然后循环“查找”单元格并根据偏移单元格设置格式。虽然这不是一个理想的选择，因为原始工作表有 243 个工作表，100-2000 行。

感谢您的帮助和提示。

A、B、C 列在前面

E,F,G 列是期望的结果

Answer 1

主要目标是遍历大约 200 张纸和 100-2000 行，并在一张纸中返回所需的输出。我认为使用集合是最快的方法。

出于速度目的，我会尝试以下方法：

• 检查每个工作表以确保数据有效
• 将整个数据范围读入 VBA 数组以加快处理速度
  • 这将比读取工作表中的每一行快五到十倍
• 使用单个集合对象将每一行存储为一个项目
• 只存储第一列没有连字符的行
• 请注意，我使用WorksheetFunction.Index 方法一次存储整个数组“行”。我没有通过循环三个元素来测试这个与创建数组的速度，但如果速度是一个问题，那将是一个想法

1. 我在运行宏之前手动创建了摘要工作表
2. 我创建了第二个与第一个类似的工作表，仅用于测试
3. 在我的工作表上，数据从第 2 行开始

Option Explicit
Sub removeIt()
    Dim WS As Worksheet
    Dim myCol As Collection
    Dim vSrc As Variant, rSrc As Range, rRes As Range
    Dim I As Long, J As Long
    Dim vRes As Variant

Set myCol = New Collection
For Each WS In ThisWorkbook.Worksheets

    'does it have the correct data
    If Not WS.Name = "Summary" And Left(WS.Cells(2, 1), 5) = "CONF/" Then
        With WS
            vSrc = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
        End With
        
        'just add the rows with no hyphen
        For I = 1 To UBound(vSrc, 1)
            If InStr(vSrc(I, 1), "-") = 0 Then
                myCol.Add WorksheetFunction.Index(vSrc, I)
            End If
        Next I
    End If
Next WS

'create a results array
ReDim vRes(1 To myCol.Count, 1 To 3)
For I = 1 To myCol.Count
    For J = 1 To 3
        vRes(I, J) = myCol(I)(J)
    Next J
Next I
                
'write the results array and format on summary worksheet
Set WS = Worksheets("Summary")
With WS
    Set rRes = Range(.Cells(1, 1), .Cells(UBound(vRes, 1), 3))
    With rRes
        .EntireColumn.Clear
        .Value = vRes
        Union(.Columns(2), .Columns(3)).NumberFormat = "yyyy.mm.dd"
        .EntireColumn.AutoFit
        .Style = "Output" 'style name is language dependent
    End With
End With
        
End Sub

数据1

数据2

结果

Answer 2

一种选择是最初创建不带“-”的集合：

Function GetCollections() 'returns array of Collection
    Dim retval(1 To 3)
    For i = 1 To 3
        Set retval(i) = New Collection
    Next
    
    Set Rng = Range("A1").CurrentRegion.Columns(1).Cells ' replace with your own range with data
    For Each cl In Rng
        If Not cl.Value Like "*-*" Then
            For i = 1 To 3
                ' if the first column A contains no "-" then iterate over collections and add the values from the near cells with offset()
                retval(i).Add cl.Offset(, i - 1).Value, CStr(cl.Row)
            Next
        End If
    Next
    GetCollections = retval
End Function

Sub Usage()
    Dim a As Collection, b  As Collection, c  As Collection, buf
    buf = GetCollections
    Set a = buf(1)
    Set b = buf(2)
    Set c = buf(3)
    
    ' do whatever you want
End Sub