Question

我要分析大量数据！我有一个表“已解决的Met” ，在G列上带有一些包含服务器名称的文本和表“服务器列表” ，其中包含服务器名称66k

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

我要做的是转到表“服务器列表” 的第一行，并在带有循环的文本所在的列中查找

一旦我有66k投放姓名和13万行文字，就花了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

在Excel中分析的66k行

1 个答案: