主页 / coding / 问题 / 79041126
Accepted
DanCue
Asked: 2024-10-01 05:56:08 +0800 CST

VBA 循环遍历多维数组并将符合条件的值保留在一列中

  • 772

我想获取工作表上的一组数据并删除其中一列包含特定文本的所有行。

最初，我以为我只能使用自动筛选，但这种方法的限制是只能排除两个条件。所以我的下一个想法是将数据放在一个数组中，然后循环遍历该列上的每一行，如果它不包含这些短语，则将其放在另一个数组中，我将使用该数组粘贴到工作表中。

以下是我迄今为止整理的相关代码。

If (leaderShtArr(i) = vpPopulationSht) Then
    leaderShtLC = leaderShtArr(i).Cells(1, Columns.Count).End(xlToLeft).Column
    leaderShtLR = eaDBWorkersSht.Cells.Find(what:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    'Reorder clicked campaign names to Calendar Order
    Dim initialArr, filteredArr As Variant
     
    initialArr = vzReporterDataSht.Range("A2:" & ColLett(leaderShtLC) & newLR).Value2
    
    For x = 1 To UBound(initialArr)
        If (initialArr(x, jobTitleCurrShtCN) <> "*EVP*" AND initialArr(x, jobTitleCurrShtCN) <> "*SVP*" AND initialArr(x, jobTitleCurrShtCN) <> "*AVP*") Then
            'WHAT GOES HERE?
        End If
    Next x
    'Paste data back into the range.
    leaderShtArr(i).Cells.Clear
    leaderShtArr(i).Range(ColLett(campaignsReportedCN) & "2").Resize(UBound(filteredArr), 1).Value2 = filteredArr
End If

以下是我的问题：

  • 我是否正确地处理了这个问题，以实现最高速度和效率？如果没有，我应该怎么做？
  • 该If语句对于在该列中查找“不包含”这些短语的单元格是否正确？

编辑：这个问题被认定为与这个问题类似。它之所以类似，是因为那是我提到的我尝试过的方法，但由于“不包含”条件的限制而无法实现。我真的很想找到一种通过数组来实现它的方法。我现在大部分时间都花在谷歌表格上，加载到数组，对数组进行操作然后粘贴是一种首选方法。我真的很想知道如何在 VBA 中做到这一点。如果它不可接受或不可取，我明白。

arrays

1 个回答

  1. Best Answer

    一种方法是重用初始数组，但将行“随机排列”到任何已删除的行中。例如

    Sub demo()
    
    Dim arwords
    arwords = Array("EVP", "SVP", "AVP")
    
    'create regex engine
    Dim Regex As Object
    Set Regex = CreateObject("vbscript.regexp")
    With Regex
      .Global = False
      .MultiLine = False
      .IgnoreCase = True
      .Pattern = Join(arwords, "|")
    End With

    Dim initialArr, v
    Dim n As Long, x As Long, y As Long, z As Long
    
    initialArr = Sheet1.Range("A1:D20").Value2
    
    For x = 1 To UBound(initialArr)
        v = initialArr(x, 1)
        If Regex.test(v) Then
            ' dont copy
            n = n + 1
        Else
            y = y + 1
            For z = 1 To UBound(initialArr, 2)
               initialArr(y, z) = initialArr(x, z)
            Next
        End If
    Next x
    
    If y > 0 Then
        Sheet2.Range("A1").Resize(y, UBound(initialArr, 2)) = initialArr
    End If
    
    MsgBox n & " rows removed", vbInformation

End Sub
    • 1

相关问题