将数据添加到唯一标识符累积的工作表中
我有一个我的队友创build一个VBA脚本为我一个相当大的Excel文件包含足球运动员的游戏logging。
该文件目前有大约7000个玩家的名字超过190000奇数行，并且每个玩家被授予唯一的PID（玩家ID）。 所以玩过10个游戏的玩家将有10行和一个唯一的PID。
脚本进入一个网站，复制玩家数据并粘贴到我的称为（目标）的Excel工作表的末尾。 当这个数据被添加到工作表时，如果已经存在与姓和名字匹配的玩家，则PID将被该玩家PID填充。 如果在从网站添加的数据中，玩家不存在，则给该玩家一个新的唯一号码。
例如：
玩家Fred SMITH PID = 1234已经存在，他的任何新logging都将获得1234的PID。
一个新的玩家Joe BLOGGS通过脚本添加，他的PID应该是现有的最高PID +1。所以如果Fred SMITH拥有最高的PID，那么Joe BLOGGS将被赋予1235的PID。
该脚本运行良好，直到添加新玩家。 导入前的数据：
PID | surname | firstname | Game | 1233| Jones | Mark | 1 1234| Smith | Fred | 2 预计import后 – 乔博客新球员
PID | surname | firstname | Game | 1233| Jones | Mark | 1 1234| Smith | Fred | 2 1235| Bloggs | Joe | 3 1234| Smith | Fred | 3
实际导入后 – 乔博客新玩家
PID | surname | firstname | Game | 1233| Jones | Mark | 1 1234| Smith | Fred | 2 1235| Bloggs | Joe | 3 1236| Smith | Fred | 3
我可以看到为什么会发生这种情况，因为脚本在列A中添加1，但是如何更改它，以便将A添加到列A中的最高数字而不是上面的行中的数字？
这是脚本：
For d = 1 To 300000 If Worksheets("Goals").Range("G" & CStr(d)).Value = surname Then If Worksheets("Goals").Range("H" & CStr(d)).Value = firstname Then PID = Worksheets("Goals").Range("A" & CStr(d)).Value ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1 Exit For Else: If Worksheets("Goals").Range("H" & CStr(d)).Value = "" Then PID = Worksheets("Goals").Range("A" & CStr(d - 1)).Value + 1 ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1 Exit For End If End If Else: If Worksheets("Goals").Range("A" & CStr(d)).Value = "" Then PID = Worksheets("Goals").Range("A" & CStr(d - 1)).Value + 1 ID = Worksheets("Goals").Range("B" & CStr(d - 1)).Value + 1 Exit For End If End If Next d
还有一些其他的优化，你可能会受益于你的脚本，抛开别的 – 你正在访问的对象层，这将减慢速度。
至于快速计算PID，有很多好方法可以做到这一点。 我个人最喜欢的（因为它最小化工作表层的访问）将是你做任何事情之前build立一个现有的PID字典。 如果你只导入20条logging，这可能需要相当长的时间，否则，使用.HasKey(PID)方法的能力将为你节省很多时间。 字典是伟大的，特别是在像VBA语言。
附注：你真正想要的是数据库中的主键。 对于所有的访问得到了太多易于使用错误，这可能是一个比Excel更好的工具这种事情。
无论如何，我会在几分钟内投入一个优化的脚本，但在此期间，您可能想要使用类似
Excel.WorksheetFunction.Max(Worksheets("Goals").Range("A1:A30000"))
当你在一个范围内的最高数字…
虽然组合firstname和surname的帮助列将加快常规查找操作，但在Scripting.Dictionary中创build虚拟查找操作对于导入操作来说可能是最好的。
要使用Scripting.Dictionary，您需要进入VBE的工具►参考并添加Microsoft脚本运行时。
您的代码示例看起来像为每个新导入的播放器遍历300K行。 你将能够看到我的理解你提供的代码片断。
Dim d As Long, lID As Long, lPID As Long, sPLYR As String Dim surname As String, firstname As String Dim dPLYRs As New Scripting.Dictionary dPLYRs.CompareMode = TextCompare 'populate scripting dictionary With Worksheets("Goals") lID = Application.Max(.Range("B:B")) lPID = Application.Max(.Range("A:A")) For d = 1 To .Cells(Rows.Count, "G").End(xlUp).Row sPLYR = .Cells(d, "G").Value & Chr(124) & .Cells(d, "H").Value If Len(sPLYR) > 1 And Not dPLYRs.Exists(sPLYR) Then dPLYRs.Add Key:=sPLYR, Item:=.Cells(d, "A").Value ElseIf Len(sPLYR) > 1 And dPLYRs.Exists(sPLYR) Then 'repair broken PIDs .Cells(d, "A") = dPLYRs.Item(sPLYR) End If Next d End With 'this is where your sample code loses me. I have no idea where surname and firstname come from 'you probably need a loop to cycle through the imported names 'you have a unique index of surname & Chr(124) & firstname as the dictionary keys for lookup with the PID as each key's item sPLYR = surname & Chr(124) & firstname dPLYRs.RemoveAll: Set dPLYRs = Nothing
所以这个字典会被所有现有的玩家，维修人员和PID发现。 我无法确定你所提供的东西。