Question

我有一个我的伴侣为我创建一个包含足球运动员游戏记录的相当大的Excel文件的VBA脚本。

该文件目前有大约7000个玩家名称，超过190000多行，每个玩家被授予一个唯一的PID（PlayerID）。因此，玩过10场比赛的玩家将有10行，其中包含一个唯一的PID。

该脚本进入一个网站，复制播放器数据并将其粘贴到名为（目标）的Excel工作表的末尾。如果在姓氏和名字上匹配的玩家已经存在，则将此数据添加到工作表中时，将使用该玩家PID填充PID。如果在从网站添加的数据中，播放器尚未存在，则会向该播放器提供新的唯一编号。

例如：

玩家Fred SMITH PID = 1234已经存在，他的任何新记录都将获得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

导入后预计 - Joe Blogs新播放器

PID | surname | firstname | Game |
1233| Jones   | Mark      | 1
1234| Smith   | Fred      | 2
1235| Bloggs  | Joe       | 3
1234| Smith   | Fred      | 3

导入后实际 - Joe Blogs新播放器

PID | surname | firstname | Game |
1233| Jones   | Mark      | 1
1234| Smith   | Fred      | 2
1235| Bloggs  | Joe       | 3
1236| Smith   | Fred      | 3

我可以看到为什么会发生这种情况，因为脚本在A列中添加1，但是如何更改它以便将A列中的最大数字加1而不是上面一行中的数字？

这是脚本：

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

Answer 1

还有一些其他优化你可能会从你的脚本中获益，除了其他任何东西 - 你正在访问对象层很多东西会减慢速度。

至于快速计算PID，有很多好方法可以做到。我个人最喜欢的（因为它最小化工作表层访问）将是在你做任何其他事情之前构建现有PID的字典。如果您只导入20条记录，这可能需要相当长的时间，但除此之外，使用.HasKey(PID)方法的能力将为您节省大量时间。字典很棒，尤其是像VBA这样的语言。

附注：您真正想要的是数据库中的主键。尽管Access因为太容易使用错误而获得了很多好处，但可能是比Excel更好的工具。

无论如何，我会在几分钟内投入一个优化的脚本，但与此同时，您可能希望使用类似

的内容

Excel.WorksheetFunction.Max(Worksheets("Goals").Range("A1:A30000"))

当你在一个范围内的最高数字之后...

Answer 2

虽然帮助列结合了 firstname 和 surname ，但会加快常规查找操作，在Scripting.Dictionary中创建虚拟查找操作可能是您进口操作的最佳选择。

要使用Scripting.Dictionary，您需要进入VBE的工具►参考资料并添加Microsoft Scripting Runtime。

您的代码示例看起来像是为每个新导入的播放器行走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。我无法确定你过去做了什么。

将数据添加到唯一标识符累积的工作表

2 个答案: