在Excel中的单元格范围内查找字母数字值

Question

我正在寻找有关我遇到的Excel问题的帮助。

我有一组字母数字范围的数据，它们与不同的值相关联。一栏中有数值。在下一列中，有字母数字范围。例如WA001-WA010。

我想做的是返回与我要查找的字母数字相关的数字。但是，该数据范围中有某些不可见的字母数字。例如，如果我要查找“ WA020”，则应返回2的值。我正在研究数组的行和间接函数，但这似乎并不是我要找的东西。

Answer 1

现在存在这样的功能。显示的公式：

Lookup Formulae

结果：

Successful results

要解决此问题而不编辑单元格的内容，您实际上被迫要做的是使用两个向量（一个索引和一个值）建立一个数据集，然后在其中查询所需的内容为了得出一个索引。至少在这种情况下，数据集是一个非常锯齿状的数组集合，至少这就是我要做的。为了保持思路清晰，我为模块创建了一个准对象模型：

Quasi Object Model

在上述照片中，收藏项的键括在括号中。

因此，如果您想实现此功能，请将其拍打到数据所在的任何工作簿中的代码模块中。

快速免责声明-以下代码不是特别优雅或高效，但确实可以完成任务。

Option Explicit

' I'm not a fan of 0-based indexing in VBA, so this fixes it for me.
' You could go without, and doing so could be a good academic
' excercise on utilizing VBA for data management.
Private Function ChangeIndex(StrIn() As String) As String()

    Dim i As Integer
    Dim temp() As String

    ReDim temp(1 To UBound(StrIn) + 1)
    For i = 1 To UBound(StrIn) + 1
        temp(i) = StrIn(i - 1)
    Next i

    ChangeIndex = temp

End Function

'Finds index of first numeric character in string
Private Function FindNumeric(ByVal StrIn As String) As Integer

    Dim i As Integer

    For i = 1 To Len(StrIn)
        If IsNumeric(Mid(StrIn, i, 1)) Then
            FindNumeric = i
            Exit Function
        End If
    Next i
End Function

'Finds numeric components of textual range
Private Function FindRange(ByVal StrIn As String) As Integer()

    Dim answer(1 To 2) As Integer
    Dim num_pos As Integer
    Dim dash_pos As Integer
    Dim temp As String
    Dim temp_two As String

    dash_pos = InStr(1, StrIn, "-", vbBinaryCompare)
    If dash_pos <> 0 Then
        num_pos = FindNumeric(StrIn)
        temp = Mid(StrIn, num_pos, Len(StrIn) - dash_pos - num_pos + 1)
        answer(1) = CInt(temp)
        temp = Mid(StrIn, dash_pos + 1, Len(StrIn) - dash_pos + 1)
        num_pos = FindNumeric(temp) + dash_pos
        temp = Mid(StrIn, num_pos, Len(StrIn) - dash_pos - (Len(StrIn) - num_pos))
        answer(2) = CInt(temp)
    Else
        num_pos = FindNumeric(StrIn)
        temp = Mid(StrIn, num_pos, Len(StrIn) - dash_pos - num_pos + 1)
        answer(1) = CInt(temp)
        answer(2) = answer(1)
    End If

    FindRange = answer

End Function

Public Function AlphaNumLU(Query As String, IndexVector As range, ValueVector As range) As Variant

    Dim csvs() As String
    Dim entries() As Collection
    Dim alpha As Collection
    Dim numeric As Collection
    Dim temp As String
    Dim q_alpha As String
    Dim q_num As Integer

    Dim entry As Variant
    Dim raw_val As Variant
    Dim i, j As Integer
    Dim range() As Integer
    Dim alpha_found As Boolean

    'The bare minimum error handling
    If IndexVector.count <> ValueVector.count Then
        MsgBox Prompt:="Input vectors must be of same length"
        AlphaNumLU = "#VALUE"
        Exit Function
    End If

    'Import Indexes to collection of entries
    ReDim entries(1 To IndexVector.count)
    For i = 1 To IndexVector.count
        Set entries(i) = New Collection
        temp = IndexVector(i, 1).Value
        entries(i).Add Item:="Entry", Key:="Label"
        entries(i).Add Item:=temp, Key:="Index"
    Next i

    'Import Values as Comma Delineated arrays of string
    For i = 1 To ValueVector.count
        temp = ValueVector(i, 1).Value
        csvs = Split(temp, ",")
        csvs = ChangeIndex(csvs)
        entries(i).Add csvs, "RawVals"
    Next i

    'Construct Textual Components
    For Each entry In entries
        For Each raw_val In entry(3)
            i = FindNumeric(raw_val) - 1
            temp = Mid(raw_val, 1, i)
            If entry.count < 3 Then
                MsgBox "Entry should be composed of items Label, Index, alpha..."
                Exit Function
            ElseIf entry.count = 3 Then
                Set alpha = New Collection
                alpha.Add Item:="text comp", Key:="Label"
                alpha.Add Item:=temp, Key:="Index"
                entry.Add alpha
            Else
                alpha_found = False
                For i = 4 To entry.count
                    If entry(i)(2) = temp Then
                        alpha_found = True
                        Exit For
                    End If
                Next i
                If Not alpha_found Then
                    Set alpha = New Collection
                    alpha.Add Item:="text comp", Key:="Label"
                    alpha.Add Item:=temp, Key:="Value"
                    entry.Add alpha
                End If
            End If
        Next raw_val
    Next entry

    'Construct Numerical Components
    For Each entry In entries
        For Each raw_val In entry(3)
            Set numeric = New Collection
            numeric.Add Item:="numeric", Key:="Label"
            range = FindRange(raw_val)
            numeric.Add Item:=range(1), Key:="Min"
            numeric.Add Item:=range(2), Key:="Max"
            temp = Left(raw_val, FindNumeric(raw_val) - 1)
            For i = 4 To entry.count
                If entry(i)(2) = temp Then
                    entry(i).Add numeric
                End If
            Next i
        Next raw_val
    Next entry


    'And Finally, Parse the Massive object we just created for the query.
    q_alpha = Left(Query, FindNumeric(Query) - 1)
    q_num = CInt(Right(Query, Len(Query) - Len(q_alpha)))
    For Each entry In entries
        For i = 4 To entry.count
            If q_alpha = entry(i)(2) Then
                For j = 3 To entry(i).count
                    If q_num >= entry(i)(j)(2) And q_num <= entry(i)(j)(3) Then
                        AlphaNumLU = entry(2)
                        Exit Function
                    End If
                Next j
            End If
        Next i
    Next entry

    'Give notice if the value doesn't exist
    AlphaNumLU = "Not Found"
 End Function

所以故事的寓意不言而喻-修改@teylyn提到的将数据呈现给查找函数的方式可能更明智。 VBA可以完成它，但不一定漂亮。