0

数値 ID のリストがある要件に取り組んでいます。ID の形式は次のとおりです。

3131010301: 最初の 6 つはマネージャーに割り当てられ、残りの 4 つの番号はチームメイトに割り当てられます。各チーム メンバーには、マネージャー ID のプレフィックスが付いた ID があり、チーム メンバーごとに最後の 4 桁のみが変更されます。

私が必要としているのは、マネージャー ID に基づいて ID を識別し、彼のチームのためにすべての情報を照合することです。これは、検索するための膨大なデータ セットになります。

INSTR のラインで Numeric に使用できるものはありますか?

ご意見をお寄せいただきありがとうございます。もちろん、不明な点がある場合はお知らせください。

4

1 に答える 1

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
于 2013-09-03T13:55:38.033 に答える