Excel VBA唯一ID生成器

Question

我试图为讨论主题生成唯一的ID。数据如下：

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

这样做的想法是，在新行上，无论它是在上一个唯一ID的上面还是下面添加，我都会使用VBA查找下一个ID。因此，例如，如果我要在顶部添加另一行和主题LANG。然后它会发现LAN-2是最新的ID，并且它的+1成为LAN-3。

当主题与下面的代码相同时(主题都是"FIL“，但现在有多个主题)，我就开始工作了：

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

有人知道我如何用ID中使用的主题缩写来设置数组，并使用我已经编写的代码遍历相同的过程，使用数组中的缩写来获得要添加的特定主题的下一个ID？

Answer 1

我调整了代码，您必须包括一个需要的数组，这确实意味着您必须将您请求ID的主题的名称传递到您的过程中，如果需要，这可以自动化，但是很难知道您的项目的更大的图景是什么，所以我留下了如下内容：-

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

Answer 2

除了第一个条目外，这段代码是有用的(“评估公式”按钮显示它正在工作，但最后它将值替换为0)。

因此，手动添加第一个ID，然后将代码从第3行运行到列表的最后一行(还需要添加代码以忽略空行)。

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