excel - 从列中拆分单词并根据数组中的条件重新加入

Question

我的电子表格中有一个“D”列，其中包含要安装的软件列表。列表很长，我只想安装几个应用程序。这里有一些例子:
第 2 行:许可证-E3； Minitab 17； Minitab 18； Proficy Historian 7.0； ;
第 3 行:许可证-E3；为 UNIX 和 OpenVMS 14.0 附加反射；感知内容桌面客户端；
第 4 行:许可证-E1； Avaya one-X® Communicator； PipelineBillingInterfaceSystemClient-V2_0； ; SAP-GUI-3Apps； Minitab 18
因此，在第一个示例中，我希望 D 列第 2 行只说:
许可证-E3,Minitab 18
第 3 行要说:License-E3,Reflection
和 4 说:License-E1,Minitab 18
这些行是根据用户 ID 列自动过滤的，即此工作表中的 A 列。
评论部分基本上是我想做的。
到目前为止，这是我的代码:

Sub FilterSoftware()

  Dim cl As Range, rng As Range, Lastrow As Integer, sSoft() As String, i As Long
  Dim vSoft As Variant, sNew As String, j As Long, sNewSoft() As String
    
  vSoft = Array("License-E3", "License-E1", "Reflection", "Minitab 18", "RSIGuard", "Java")
  
      
  Dim Ws As Worksheet: Set Ws = Sheet1
  
  With Ws
    Lastrow = .Range("D" & .Rows.Count).End(xlUp).Row
  End With

  Set rng = Range("D2:D" & Lastrow)

  For Each cl In rng.SpecialCells(xlCellTypeVisible)
      sSoft = Split(cl, ";")
        For i = LBound(sSoft) To UBound(sSoft)
          If Not sSoft(i) = " " Then
            For j = LBound(vSoft) To UBound(vSoft)
              sNewSoft = Split(vSoft(j), " ")
              Debug.Print Trim$(sSoft(i))
              Debug.Print Trim$(vSoft(j))

              'if sSoft(i) contains any words from vSoft(j)
              'Join vSoft(j) with comma delimiter until full
              'and overwrite in column D

            Next j
          End If
        Next i
   Next cl
End Sub

Answer 1

请使用下一个改编的代码。它将在下一列中返回，仅用于测试原因。如果它返回您需要的内容，您可以更改 cl.Offset(0, 1).Value = Join(sNew, ",")与 cl.Value = Join(sNew, ",") :

Sub FilterSoftware()
  Dim cl As Range, rng As Range, Lastrow As Long, sSoft
  Dim vSoft, sNew, i As Long, j As Long, t As Long
    
  vSoft = Array("License-E3", "License-E1", "Reflection", "Minitab 18", "RSIGuard", "Java")
  
  Dim Ws As Worksheet: Set Ws = ActiveSheet ' Sheet1
  Lastrow = Ws.Range("D" & Ws.rows.count).End(xlUp).row

  Set rng = Range("D2:D" & Lastrow)
  ReDim sNew(UBound(vSoft)) 'redim the array to a dimension to be sure it will include all occurrences
  
  For Each cl In rng.SpecialCells(xlCellTypeVisible)
      sSoft = Split(cl, ";")
        For i = LBound(sSoft) To UBound(sSoft)
          If Not sSoft(i) = "" Then                 'for cases of two consecutive ";"
            For j = LBound(vSoft) To UBound(vSoft)
                If InStr(1, sSoft(i), vSoft(j), vbTextCompare) > 0 Then
                    sNew(t) = vSoft(j): t = t + 1: Exit For
                End If
            Next j
          End If
        Next i
        If t > 0 Then
            ReDim Preserve sNew(t - 1)              'keep only the array filled elements
            cl.Offset(0, 1).Value = Join(sNew, ",") 'put the value in the next column (for testing reason)
            ReDim sNew(UBound(vSoft)): t = 0        'reinitialize the variables
        End If
   Next cl
End Sub