vba-字典和数组

Question

这里的想法是我有一张工作表，其中有80,000多行和六列不同的列。我关心的是2列。我希望vba遍历每一行，在此“ -> ”符号。然后，从所有行中检索出值之后，将结果打印在新表的4列中。

请注意，一个IP地址可以与许多不同的单词相关。

我正在寻找的是vba在一列中返回源IP，然后下一列具有在F列中找到的最后一个单词，然后c列应该具有F列的中间部分，最后是最后一列具有在F列中最后一个单词找到特定IP的次数

这是表格的外观（B，C，D，E，F列）（行8 = <）：

这是我希望结果看起来像的样子：

到目前为止，这是我所能获得的，幸运的是，我能够获得源ip，F列的最后一个单词以及与该IP相关的时间，但是我无法弄清楚如何使数组成为中间位置。 F列的一部分，以便能够循环以使其值与字典中存储的值匹配以便打印出来。

Sub timesofattackanddestination()

    Dim data As Variant, dic As Object, k As Long, ks As String, kss() As Variant

    Set dic = CreateObject("Scripting.Dictionary")

    With ThisWorkbook.Worksheets("Sheet2")
        data = .Range("D8", .Range("D" & .Rows.Count).End(xlUp).Offset(0, 2)).Value2
    End With

    Dim i As Long
    Dim c As Long
    i = Range("d8").End(xlDown).Row
    ReDim kss(i)

    For k = LBound(data, 1) To UBound(data, 1)
        ks = Join(Array(data(k, 1), Split(data(k, 3) & "-> ", "-> ")(1)), ChrW(8203))
        kss(k) = Split(data(k, 3), "] ")(1)
        dic(ks) = dic(ks) + 1
    Next

    With ThisWorkbook.Worksheets.Add
        .Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.Keys)
        .Range("d2").Resize(dic.Count).Value = Application.Transpose(dic.Items)
        .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp)).TextToColumns _
            Destination:=.Cells(2, "A"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=ChrW(8203), _
            ConsecutiveDelimiter:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))
    End With

    For c = 1 To Range("A2").End(xlDown).Row
        For i = 1 To dic.Count
            If Range("A" & c + 1).Value = dic(i) Then
                Range("D" & c + 1).Value = kss(i)
            End If
        Next i
    Next c

End Sub