查找通用名称

时间:2015-07-29 09:59:02

标签: excel vba database-design

对于同一家公司有许多不同名称的大型数据库,我有点问题。基本上,我要做的就是找到代表公司X的所有名称并将它们更改为" X"。

这样,如果详细名称是" X SL"或者"装运登记处ASL"或" oubiyubib(2)"我们知道所有三个代表公司" X",我必须寻找它们并手动更改它们。还有一些名为" NISA"这意味着代表公司所在的行业,因为有时候我处理的文件中出现的那个是错误的。

为了解决这个问题,我创建了一个excel,它存储了各个公司的所有已知名称,然后相应地替换了列表中的名称。存储数据的结构如下:

Captura 因此,在第一栏中,有#NISA" NISA"第二个具有公司的通用名称,而后面的列是公司的已知名称。整个名称列由字符按字母顺序排列,并带有" 1"。

然后,有" INDICE"其中详细说明了出现第一个带有三个字母组合的实例的行。这样,名字以" 3SU"开头。排在第28行。" INDICIE 2"是详细说明" INDICE"中的第一个字母,所以是索引的索引。意思是" INDICE"中的第一行以" A"开头将在第39行。

所有这一切的主要原因是因为数据库在某些情况下迅速增长到包含超过25K行和超过100列,并且因为有时" 3MSA"是一个完全不同于" 3MSL"的公司,必须逐字逐句地检查它是否是它的合适通用名称。

所以大部分代码都是这样的:

Dim listRow As Long, searchRow As Long
Dim searchedName As String, genericName As String
Dim problem As Boolean
problem = False
listRow = 2
searchRow = 2
searchedName = ""
genericName = ""

Do While Cells(listRow, colmnNames) <> ""
    searchedName = UCase(Cells(listRow, colmnNames))
    searchRow = 0
    'This part compares if it's looking again for the same name. If it is, it'll just copy the previous results
    If Cells(listRow, colmnNames) = Cells(listRow - 1, colmnNames) Then
        Cells(listRow, colmnResults) = Cells(listRow - 1, colmnResults)
        Cells(listRow, colmnRestNisa) = Cells(listRow - 1, colmnRestNisa)
        Cells(listRow, errorsA) = Cells(listRow - 1, errorsA)
        Cells(listRow, errorsB) = Cells(listRow - 1, errorsB)
    Else
        Cells(listRow, colmnNames).Select
        searchRow = IndexRunner(searchedName) '" IndexRunner " will return the row it will have to start looking, if it's 0 then it means the starting letter combination doesn't exist
        If searchRow > 0 Then
            searchRow = Finder(searchRow, searchedName) '"Finder" will traverse the database row by row, running the columns until it reaches a blank comparing name by name until it finds a match. If it gets outside the starting 3 letter combination, it stops and returns 0, otherwise, it'll return the row where it found the match
            If searchRow > 0 Then
                Cells(listRow, colmnResults) = Cells(searchRow, "B")
                Cells(listRow, colmnRestNisa) = Cells(searchRow, "A")
            Else
                GoTo NotFound
            End If
        Else
NotFound: 

            Cells(listRow, colmnResults) = searchedName
            Cells(listRow, colmnRestNisa) = Cells(listRow, colmnSectores)
            Cells(listRow, errorsA) = searchedName
            Cells(listRow, errorsB) = Cells(listRow, colmnSectores)
            Cells(listRow, erroresC) = "Not Found"
            problem = True 'This is so there'll be a popup at the end of the loop.
        End If
    End If
    listRow = listRow + 1
Loop

因为代码围绕&#34;只有在名称的前三个字母匹配时才进行,所以我已经能够大大减少处理时间,但它仍然可以接近一小时可以通过一个50K长的名单,所以在这一点上我想知道是否有任何方法可以让它在VBA中更快地进行,或者只是用其他方式来构建所有这些。

注意:我无法访问其他软件,而且我在哪里工作,他们有严格的“不允许”#34;规则要向计算机添加任何东西,所以我一直坚持使用excel VBA,直到上面有人得到提示。

1 个答案:

答案 0 :(得分:1)

首先,如果您想加速代码,可以使用以下代码片段:

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlManual

将其放在Dim部分后面,并放在相同片段的代码末尾,然后将值更改回true xlAutomatic

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic

在我的情况下,它提高了代码的速度。如果您跳过DisplayAlerts行以便在有某些内容时显示提醒,我不知道性能如何变化。

如果您还想重新构建代码,则需要更多时间。