1

我正在开发一个程序，其目的是识别数据库中地址的一部分。输入是一列，每个单元格包含地址中的一个单词/数字。另一方面，在数据库中，每个单元格都包含了几个单词的完整信息。

这是一个例子： 在此处输入图像描述

这是我已经在做的事情：
1/在数据库列中循环（这里从 G3 到 G7）并激活当前单元格。
2/对于 (B2:B9) 的每个单元格，查找与 ActiveCell的匹配项
3/如果找到匹配项，则将 10 个点添加到单元格，当 B 列中的循环完成时，从数据库中跳到另一个单元格。所以在这个例子中，G3 中有 3 场比赛，所以 30 分。

没关系，但我想通过考虑到单词“General Finance Tower”的位置来使其更准确，这将被发现与数据库匹配。

为此，我计划将 G 中单元格的内容拆分为一个数组。

以下是改进的方法：
1/在 G2:G7 的数据库列中循环。拆分包含 n 个单词的数组中的第一个单元格（本例中为 3 个）：“General / Finance / Tower”
2/在数组的第一个单词和列 B 中的元素之间查找匹配项。如果否，则匹配，跳到下一个元素（B2，B3，... B9）。如果在 B9 之后仍然没有匹配，则跳到数组的第二个元素（财务）并继续。
如果匹配（此处在“General”（数组的第一个元素）和 B2 之间）然后查看数组的下一个元素和 B 列的下一个元素（“Finance”和“Finance”）之间是否匹配。如果是，再做一次（“塔”和“塔”）等等。

这样，“通用金融”就会被发现，然后是“通用金融塔”，从而使我的程序更加准确。

这是我的问题，与编程更相关：

我知道如何将 G 列拆分为数组，但我不知道如何在其中导航。如果不是一个数组而是 N 个不同的单元格，我会从单元格 1 开始，激活它，然后使用 offset(1,0) 转到下一个单元格，使用 offset(2,0) 进一步转到两个单元格，然后依此类推，在每种情况下都寻找匹配项。使用数组时如何做到这一点？如何进入下一个元素？

 stringData = Split(ActiveCell.Value, " ")  
 For i = LBound(stringData) To UBound(stringData)
 If Match(ActiveCell, stringData(i)) Then ...
 else  
 End If
 Next i

这将允许我从第一个元素到最后一个元素，但不会真正为我提供导航选项（例如，如果当前元素匹配，则直接查找与第二个元素的匹配项）。

提前感谢您的建议，这真的很有帮助！

4

1 回答 1

1

嗯，是的，所以我为您编写了代码，该代码将根据我对您的问题复杂性的理解进行评分。输入和输出如下所示： 输入输出

并且代码...
x) 有太多注释，您应该能够轻松地对其进行修改，以防万一出现问题。

Option Explicit

Sub DatabaseVsInputComparison_Scoring()

    Dim ws              As Worksheet    ' worksheet instance
    Dim i&, j&, k&, x   As Long         ' iterators
    Dim db_startRow     As Long         ' -->
    Dim db_startColumn  As Long         ' -->  These variables will
    Dim db_lastRow      As Long         ' -->  store the database table
    Dim db_lastColumn   As Long         ' -->  boundries
    Dim inp_startRow    As Long         ' starting row of the data in INPUT column
    Dim inp_lastRow     As Long         ' last row in the INPUT column
    Dim inp_column      As Long         ' the column number of the INPUT column
    Dim rng             As Range        ' active db range reference
    Dim inp_rng         As Range        ' active input ref
    Dim score           As Long         ' store temporary score

    ' // setters
    Set ws = Sheets("Sheet1")           ' set reference
    db_startRow = 3                     ' set starting row for the database data
    db_startColumn = 7                  ' set starting column for the database data
    inp_startRow = 2                    ' set starting row of the data in input column
    inp_column = 2                      ' set starting row for the input column

    ' // getters
    ' get the boundries of the database table
    db_lastRow = ws.Cells(Rows.Count, db_startColumn).End(xlUp).Row
    db_lastColumn = ws.Cells(db_startRow, Columns.Count).End(xlToLeft).Column
    inp_lastRow = ws.Cells(Rows.Count, inp_column).End(xlUp).Row

    ' iterate through the database table
    For i = db_startRow To db_lastRow ' each ROW
        For j = db_startColumn To db_lastColumn ' each COLUMN
            score = 0 ' reset the score for each cell in the database set
            Set rng = ws.Cells(i, j)
            Dim splitted ' array storing each word of the "active" cell
            splitted = Split(rng.Value, " ")
            If UBound(splitted) > -1 Then
                For k = inp_startRow To inp_lastRow ' each input column data cell
                    Set inp_rng = ws.Cells(k, inp_column)
                    ' check if the first word has got a match in the input column
                    If StrComp(CStr(splitted(0)), inp_rng.Value, 1) = 0 Then

                        score = 12 ' set initial score

                        ' this is where you want to iterate through the rest of the active database cell
                        '   and check if the next words match, right?
                        For x = 1 To UBound(splitted)
                            ' now youre checking the next word in the splitted array
                            '   against the next word in the input column
                            If StrComp(CStr(splitted(x)), inp_rng.Offset(x, 0).Value, 1) = 0 Then
                                ' if the match is found you want to keep on checking
                                ' and incrementing the score
                                score = score + 12

                            ' if no match you want to exit the loop
                            ' > no extra score
                            Else
                                Exit For
                            End If
                        Next x

                    End If
                    Set inp_rng = Nothing
                Next k
                ' score calculation
                ' if max score reached then add extra 3 to the score
                If score = ((UBound(splitted) + 1) * 12) Then score = score + 3
                rng.Offset(0, 5).Value = score
                Set rng = Nothing
            End If
        Next j
    Next i

End Sub
于 2013-06-19T08:44:14.320 回答