excel - 在 Excel 中分析 66k 行

Question

我要分析海量数据!
我有一张 table 《解决遇见》并在 G 列上带有一些包含服务器名称的文本
和表 《服务器列表》有 66k 的服务器名称

我必须分析文本是否包含表 上的服务器名称《服务器列表》如果是，则将服务器名称写在文本前面(在另一个单元格中)

我所做的是转到表的第一行 《服务器列表》并在带有循环的文本所在的列上查找它

一旦我有 66k 服务名称和 130k 行文本，分析所有内容需要 6 个多小时。
这是我的代码。你有更好的主意让它更快吗？

Sub ()

i = 1
Sheets("Server List").Select
Range("A1").Select

servername = ActiveCell.Offset(i, 0).Value

Do Until IsEmpty(servername)

    Sheets("Resolved Met").Select

    With Worksheets("Resolved Met").Range("G:G")
        Set server = .find(What:=servername, LookIn:=xlValues)
        If Not server Is Nothing Then
            firstAddress = server.Address
            Range(firstAddress).Select
            ActiveCell.Offset(0, 13) = servername
            Do
                Set server = .FindNext(server)
                If server Is Nothing Then
                    GoTo DoneFinding2
                End If
                SecondAdress = server.Address
                Range(SecondAdress).Select
                ActiveCell.Offset(0, 13) = servername

            Loop While SecondAdress <> firstAddress
        End If
        DoneFinding2:
    End With


    Sheets("Server List").Select
    i = i + 1
    servername = ActiveCell.Offset(i, 0).Value

Loop

Answer 1

您可以使用 Dictionary为此并获得更好的性能

Sub t()

    Dim dict As Object

    Dim i As Long
    Dim endrow As Long

    Set dict = CreateObject("Scripting.Dictionary")

    With Sheets("Server List")
        endrow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If .Range("A" & i) <> "" Then
                dict.Add CStr(.Range("A" & i)), .Range("A" & i)
            End If
        Next

    End With

    With Sheets("Resolved Met")
        endrow = .Range("G" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If dict.Exists(CStr(.Range("G" & i))) Then
                .Range("G" & i).Offset(0, 13) = dict(CStr(.Range("G" & i)))
            End If
        Next

    End With

End Sub

编辑:

下面的代码基于您的评论和您附加的数据的结构。它假设与提供的数据集一样， servername将用空格与随机文本隔开。我通过扩展提供的数据集对此进行了测试(在 Server List 中扩展为 66K 服务器名称，在 Resolved Met 中扩展为 130K 行)并在 372.672 秒内获得了正确的结果。有点冗长，但与之前方法中记录的约 6 小时相比，运行时间减少了约 98.3%。

Sub ServerNameLookup()
    Dim dict As Object

    Dim i As Long
    Dim endrow As Long

    Dim textArr
    Dim iText As Long

    Set dict = CreateObject("Scripting.Dictionary")

    With Sheets("Server List")
        endrow = .Range("A" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            If .Range("A" & i) <> "" Then
                dict.Add CStr(.Range("A" & i)), .Range("A" & i)
            End If
        Next

    End With

    With Sheets("Resolved Met")
        endrow = .Range("G" & Rows.Count).End(xlUp).Row

        For i = 2 To endrow
            textArr = Split(.Range("G" & i), " ")
            For iText = LBound(textArr) To UBound(textArr)
                If dict.Exists(CStr(textArr(iText))) Then
                    .Range("G" & i).Offset(0, 13) = dict(CStr(textArr(iText)))
                End If
            Next iText
        Next

    End With
End Sub