Question

我正在对两张不同的Excel表格上的两列（长度不等）进行验证。

第一个工作表名称是＆＃39;任务＆＃39;。专栏＆＃39; A＆＃39;任务＆＃39;表有大约200个城市名称。

第二张表是＆＃39; Cities＆＃39;。专栏＆＃39; A＆＃39;的城市＆＃39;工作表有大约8000多个城市名称。

现在，我需要进行验证，以便在“A＆lt;任务”栏A列中显示城市名称。表应该是

列＆＃39; A＆＃39;中指定的城市名称中的任何一个。工作表＆＃39;城市＆＃39;
或者它可以有多个以分号分隔的条目;在以分号分隔所有城市之后，每个城市名称应与“城市”中D列中的城市名称相匹配。片材。
如果不是上述两种情况，那么它应该是所有＆＃39;

任务＆＃39;中的细胞。城市名称不匹配的工作表将在红色背景中打开

我的代码如下:(我只是提供所需的部分代码）

Dim CityString As String
Dim CityArray() As String

'Get the last row
'Dim lastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count


Dim c As Range
Dim d As Range
Dim e As Variant

'Turn screen updating off to speed up macro code.
'User won't be able to see what the macro is doing, but it will run faster.
Application.ScreenUpdating = False

For Each c In Worksheets("Task").Range("A2:A" & LastRow).Cells
CityString = c
CityArray() = Split(CityString, ";")
For Each e In CityArray()
e = Trim(e)
    For Each d In Worksheets("Cities").Range("A2:A" & LastRow).Cells
        c.Interior.Color = vbRed

        If (UCase(e) = UCase(d) Or c = "All") Then
        c.Interior.Color = vbWhite
        Exit For
        End If
    Next
    If c.Interior.Color = vbRed Then
    Exit For
    End If
Next
Next

现在，上述代码仅在两张工作表（Sheet1 - ＆＃39; Task＆＃39;和Sheet2 - ＆＃39; Cities＆＃39;具有相同数量的记录时才有效。如果Sheet2 - ＆＃39;城市的记录多于“任务”表，上述代码不起作用。

例如：纽约在A55＆＃39;细胞任务＆＃39;片。它也在＆＃39;城市＆＃39;在＆＃39; A41＆＃39;表单。我的代码正确验证了单元格。

例如：＆＃39; A53＆＃39;任务＆＃39;我有东京＆＃39;东京＆＃39;和＆＃39;任务＆＃39; Sheet只有200条记录，其中＆＃39; Tokyo＆＃39;出现在A988＆＃39; ＆＃39;城市＆＃39; sheet，有8000多条记录，然后我的代码不能正确验证这个单元格。

任何人都可以给我一个替代代码吗？我需要代码来比较两个长度不等的列的记录。

Answer 1

循环搜索匹配的值列表效率不高。每个列表越长，运行宏所需的时间就越长。而是使用内置的 FIND 方法来搜索值。

我已更新代码以显示正在运行的FIND方法。检查一下，让我知道这是否有意义。

（侧面注释）：我在上面留下了一条评论，详细说明了为什么您的初始代码无法正常工作。您需要第二个变量来引用城市表的最后一行。

Dim CityString As String
Dim CityArray() As String

'Get the last row
'Dim lastRow As Integer
LastRow = Sheets("Task").UsedRange.Rows.Count
nLastRowSheet2 = Sheets("Cities").UsedRange.Rows.Count

Dim c As Range
Dim d As Range
Dim e As Variant

'Turn screen updating off to speed up macro code.
'User won't be able to see what the macro is doing, but it will run faster.
Application.ScreenUpdating = False

For Each c In Worksheets("Task").Range("A2:A" & LastRow)
    CityString = c
    CityArray() = Split(CityString, ";")
    For Each e In CityArray()
        e = Trim(e)

        Dim rngFnder As Range
        On Error Resume Next

            Set rngFnder = Sheets("Cities").Range("A2:A" & nLastRowSheet2).Find(e)

            If rngFnder Is Nothing Then
                c.Interior.Color = vbRed
            End If

        On Error GoTo 0
    Next
Next

比较两列长度不等的记录

1 个答案: