excel - 使用号码列表搜索号码

Question

我正在处理一个我有数字 ID 列表的要求。ID 的格式如下：

3131010301: 前 6 个号码分配给经理，其余 4 个号码分配给他的队友。每个团队成员都有一个 ID，其前缀为 Managers ID，每个团队成员只有最后 4 位数字发生变化。

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

我们在 INSTR 行中是否有任何可用于 Numeric 的内容？

感谢您的意见，当然如果不清楚，请告诉我。

Answer 1

假设您的电子表格如下所示

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

B 列有前 6 位数字 - 我想你称之为经理 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