我要分析大量的数据!我有一个表"Resolved“,在G列上有一个包含服务器名称的文本和一个服务器名称为66k的表”服务器列表“
我必须分析文本是否包含表“服务器列表”上的服务器名称,如果是,则在文本前面(在另一个单元格中)写入服务器名称。
我所做的是转到表“服务器列表”的第一行,并在文本带有循环的列中查找它
一旦我有了66k的服务名称和130 k行文本,就需要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发布于 2019-02-19 21:17:08
您可以利用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中扩展到130 K行)测试了这一点,并在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 Subhttps://stackoverflow.com/questions/54774807
复制相似问题