vba - 从顶部删除串联的重复项

我已经对下面的宏进行了编码，当我将值保存到立即窗口时，它可以工作，但是不知道如何将以“，”分隔的值填充到一个单元格中。基本上，我在列中查找“活动”，如果找到，则向左移动4个单元格并从此处获取信息...
你能帮忙吗？

Dim Active() As Variant
Dim i
ReDim Active(Range("G9:G24").Cells.Count)
For Each Zelle In Range("G9:G24")
If InStr(1, Zelle, "Active") <> 0 Then
Active(i) = Zelle.Offset(0, -4)
End If
i = i + 1
Next Zelle

 For i = LBound(Active) To UBound(Active)
 If Trim(Active(i)) <> "" Then
   Debug.Print Active(i)
   End If
  Next i
  End Sub

最佳答案

您可以通过遍历仅与C列中非空白单元格相对应的范围单元格来极大地缩短代码

    Dim Zelle As Range
    Dim resultStrng As String

    For Each Zelle In Range("G9:G24").Offset(,-4).SpecialCells(xlCellTypeConstants) '<--| loop through not blank cell in range 4 columns to the left of G9:G24
        If InStr(1, Zelle.Offset(, 4), "Active") <> 0 And Trim(Zelle) <> "" And Instr(resultStrng, Trim(Zelle)) =0 Then resultStrng = resultStrng & Trim(Zelle) & "," '<--| update your result string whenever current cell has a character and its 4 columns to the right offset cell meets the "Active" criteria
    Next Zelle
    If resultStrng <> "" Then resultStrng = Left(resultStrng, Len(resultStrng) - 1) '<-- remove the last comma from 'resultStrng'