Excel VBA唯一ID生成器

Question

I am trying to generate unique IDs for topics of discussion. The data will be like so:

Status    ID        Topic    Commentary
Open      FIL-1     FILM      
Open      FIL-2     FILM
Closed    LAN-1     LANG.
Open      LAN-2     LANG.

The idea is that when on a new row regardless of whether it was added above or below of the last unique ID I use VBA to find the next ID. So for example above if I were to add another row at the top with the topic LANG. then it would find that LAN-2 is the lastest ID and +1 to it to become LAN-3.

I got this working when the topics were all the same with the code below (topics were all "FIL" but now there are multiple topics):

Private Function getNextID() As String

Dim row As Integer
Dim currentID As Integer

currentID = 0

' Loop round rows
For row = MIN_ROW To MAX_ROW

    ' Only use rows which are not blank
    If Worksheets(DISCUSS).cells(row, ID).Value <> "" Then
        If Mid$(Worksheets(DISCUSS).cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).cells(row, ID).Value, "-") + 1) > currentID Then
           currentID = Mid$(Worksheets(DISCUSS).cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).cells(row, ID).Value, "-") + 1)
        End If
    End If

Next row

getNextID = "FIL" & "-" & currentID + 1

End Function

Does anyone know how I can set an array with the topic abbreviations used in the ID and use the code i've already written to loop through the same process using the abbreviations in the array to get the next ID for the specific topic being added?

Answer 1

This code does the trick, except the first entry for some reason (the Evaluate Formula button shows it's working, but right at the end it replaces the value with 0).

So, manually add the first ID then run the code from row 3 to the last row of your list (you'll also need to add code to ignore empty rows).

Public Sub Test()

    Dim x As Long

    For x = 3 To 7
        AddID ThisWorkbook.Worksheets("Sheet1").Cells(x, 2)
    Next x

End Sub

Public Sub AddID(Target As Range)

    'Formula using A1 style:
    '=LEFT($C7,3) & "-" & COUNTIF($B$2:INDEX($B:$B,ROW()-1),LEFT($C7,3) & "*")+1

    'Relative column (ID is 1 column left of Topic).
    Target.FormulaR1C1 = "=LEFT(RC[1],3) & ""-"" & COUNTIF(R2C:INDEX(C,ROW()-1), LEFT(RC[1],3) & ""*"")+1"
    'Absolute column (ID is column B, Topic is column C)
    'Target.FormulaR1C1 = "=LEFT(RC3,3) & ""-"" & COUNTIF(R2C2:INDEX(C2,ROW()-1), LEFT(RC3,3) & ""*"")+1"
    Target = Target.Value

End Sub

Answer 2

I adjusted the code you had to include an array like you needed, it does mean you will have to pass into your procedure the name of the topic you are requesting an ID for, this could be automated if needed but its hard to know what the bigger picture is for you project so I have left it as this: -

Private Function getNextID(ByVal StrTopic As String) As String
Static AryTopics(2, 1)     As String
Dim row                     As Integer
Dim currentID               As Integer
Dim LngCounter              As Long
currentID = 0

'By having the array declared static and being a fixed size, it will only get built once
'then rememebered
If AryTopics(0, 0) = "" Then
    AryTopics(0, 0) = "FILM"
    AryTopics(0, 1) = "FIL"
    AryTopics(1, 0) = "LANG."
    AryTopics(1, 1) = "LAN"
    AryTopics(2, 0) = "GEOG."
    AryTopics(2, 1) = "GEO"
End If

'The topic must be passed into the proce to know what to get the ID for
'This gets the related topic code from the array
For LngCounter = 0 To UBound(AryTopics, 1)
    If AryTopics(LngCounter, 0) = Trim(UCase(StrTopic)) Then
        StrTopic = AryTopics(LngCounter, 1)
        Exit For
    End If
Next

' Loop round rows
For row = MIN_ROW To MAX_ROW

    ' Only use rows which are not blank
    If Worksheets(DISCUSS).Cells(row, ID).Value <> "" Then

        'This checks to see if the ID starts with the related topic code we care about, if it does then we keep checking
        If Left(Trim(UCase(Worksheets(DISCUSS).Cells(row, ID).Value)), Len(StrTopic) + 1) = StrTopic & "-" Then

            If Mid$(Worksheets(DISCUSS).Cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).Cells(row, ID).Value, "-") + 1) > currentID Then
                currentID = Mid$(Worksheets(DISCUSS).Cells(row, ID).Value, InStr(3, Worksheets(DISCUSS).Cells(row, ID).Value, "-") + 1)
            End If

        End If
    End If

Next row

'Output include the topic code
getNextRiskID = StrTopic & "-" & currentID + 1

End Function