首页 > 解决方案 > 验证 sheet2 中的前缀是否在 sheet1 中具有匹配值

问题描述

我有以下问题:在一个工作簿中,我有多个工作表。

在从第 2 行开始的“D”列的第 2 页上,是 300 多个 4 位数长前缀的列表,例如 XFTZ、GHTU、ZAQS 等。

在从第 3 行开始的“R”列中的工作表 1 上,是一个包含 1000 多个值的列表,这些值可以具有以下值,例如:AAAA1234556 和 ZAQS12565865。第一个值 AAAA...... 是允许的,其中第二个值 ZAQS...... 应该在运行 VBA 代码时抛出错误消息。

两张表中的值列表会随着时间的推移而增长,所以我想避免对记录进行硬编码。我希望这里最好的解决方案是使用这样的东西:

LastRowNr = Cells(Rows.Count, 1).End(xlUp).Row

标签: excelvba

解决方案


尝试以下类似的操作,替换Sheet1为实际数据所在的名称

Option Explicit

Private Sub searchPrefix()
    Dim RangeInArray() As Variant
    Dim LastRow1 As Long
    Dim LastRow2 As Long
    Dim tmpSrch As String
    Dim i As Long

    LastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 18).End(xlUp).Row
    LastRow2 = Worksheets("PREFIXES").Cells(Rows.Count, 4).End(xlUp).Row
    RangeInArray = Application.Transpose(Worksheets("PREFIXES").Range("D1:D" & LastRow2).Value)

    For i = 3 To LastRow1
        If Len(Worksheets("Sheet1").Cells(i, 18).Value) >= 3 Then
            tmpSrch = Left(Worksheets("Sheet1").Cells(i, 18).Value, 4) '18: column R
            If IsInArray(tmpSrch, RangeInArray) Then
                Worksheets("Sheet1").Cells(i, 18).Interior.ColorIndex = xlNone
                Worksheets("Sheet1").Cells(i, 18).Font.ColorIndex = 0
                Worksheets("Sheet1").Cells(i, 18).Font.Bold = False
            Else
                Worksheets("Sheet1").Cells(i, 18).Interior.Color = RGB(252, 134, 75)
                Worksheets("Sheet1").Cells(i, 18).Font.Color = RGB(181, 24, 7)
                Worksheets("Sheet1").Cells(i, 18).Font.Bold = True
            End If
        End If
    Next
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

推荐阅读