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

Question

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

示例工作表：

1.Get 列 'A'、'B' 和 'C' 到单独的 collection 中。

2.Check collection 'A' 项，如果它们包含“-”。

如果项目包含“-”删除所有 3 collections 中具有相同索引的项目。
然后将 collection 'A' 卸载到列 'D' 并根据“B”列和“C”列 [=74] 循环格式化单元格=] 相同的索引项值 ="" 或 not ="".

初始代码：

正在创建 collection：

    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

正在检查 collections:

     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

遇到的问题：

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

    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

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

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

感谢您的帮助和提示。

A、B、C列在

之前

E,F,G 列是想要的结果

Answer 1

一个选项是创建最初没有“-”的集合：

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

Answer 2

主要目标是循环遍历大约 200 sheet 和 100-2000 行，并 return 在单个 sheet 中获得所需的输出。我认为使用集合是最快的方法。

为了提高速度，我会尝试以下操作：

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

我在运行宏
我创作了第二个作品sheet和第一个差不多，只是为了测试
在我的 sheet 上，数据从第 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

Data2

结果

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

How to delete specific items from a VBA collection?

collections

excel

vba

loops