使用数字列表搜索数字

Question

我正在制定一项要求，其中包含数字ID列表。 ID的格式如下：

3131010301：前6名被分配给经理，其余4名被分配给他的队友。每个团队成员都有一个ID，其前缀为Managers ID，每个团队成员只有最后4位数字。

我需要根据经理ID识别ID，并为他的团队整理所有信息。这将是一个庞大的搜索数据集。

我们在INSTR中有什么可以用于数字的吗？

感谢您的意见和回答，如果不清楚，请告诉我。

Answer 1

假设您的电子表格看起来像这样

我编写了一个代码，将经理和成员ID分成两个不同的列

B列的前6位数字 - 我认为您称之为Managers ID

C列具有4位数的团队成员ID

因此，将电子表格设置为与第一张图片类似，然后运行代码

Option Explicit

Sub ManagersAndTheirTeams()
Application.ScreenUpdating = False
    ReDim arr(Range("A" & Rows.Count).End(xlUp).Row - 1) As String

    Dim r As Range
    Dim i As Long, j As Long, c As Long
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set r = Range("A" & i)
        arr(i - 1) = r
        Set r = Nothing
    Next i

    RemoveDuplicate arr

    Columns("B:C").NumberFormat = "@"

    For i = LBound(arr) To UBound(arr)
        For j = 1 To Range("A" & Rows.Count).End(xlUp).Row
            Set r = Range("A" & j)
            If StrComp(Left(arr(i), 6), Left(r, 6), vbTextCompare) = 0 Then
                Range("B" & j) = Left(arr(i), 6)
                Range("C" & j) = Right(r, 4)
            End If
            Set r = Nothing
        Next j
    Next i

    For i = LBound(arr) To UBound(arr)
        For j = 1 To Range("B" & Rows.Count).End(xlUp).Row
            Set r = Range("B" & j)
            If StrComp(Left(arr(i), 6), r, vbTextCompare) = 0 Then
                c = c + 1
                If c > 1 Then
                    r.ClearContents
                End If
            End If
            Set r = Nothing
        Next j
        c = 0
    Next i

Application.ScreenUpdating = True
End Sub

Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
    If (Not StringArray) = True Then Exit Sub
    lowBound = LBound(StringArray): UpBound = UBound(StringArray)
    ReDim tempArray(lowBound To UpBound)
    cur = lowBound: tempArray(cur) = StringArray(lowBound)
    For A = lowBound + 1 To UpBound
        For B = lowBound To cur
            If LenB(tempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B: tempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray
End Sub