66k строк для анализа в Excel

Question

Я огромное количество данных для анализа!У меня есть таблица «Resolved Met» и столбец G с текстом, содержащим имя сервера и таблицу «Список серверов» с 66k именами серверов

Iнужно проанализировать, содержит ли текст имя сервера в таблице «Список серверов» и, если да, написать имя сервера перед текстом (в другой ячейке)

То, что я сделал, былочтобы перейти к первой строке таблицы «Список серверов» и найти ее в столбце, где текст с циклом

Прошло более 6 часов, чтобы проанализировать все, как только у меня 66kслужит имя и 130k строк текста.Вот мой кодУ вас есть идея лучше сделать это быстрее?

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 будет отделен от случайного текста пробелом.Я протестировал это с расширением предоставленного набора данных (расширен до 66K имен серверов в Server List и 130K строк в Resolved Met) и добился правильных результатов за 372,672 секунды.Немного длинновато, но время выполнения уменьшается примерно на 98,3% по сравнению с ~ 6 часами, указанными в предыдущем методе.

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