Excel VBA唯一ID生成器

时间:2016-06-15 09:48:25

标签: excel vba

我正在尝试为讨论主题生成唯一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,并且它将成为LAN-3的+1。

当主题与下面的代码完全相同时(主题都是“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被添加?

2 个答案:

答案 0 :(得分:0)

此代码可以解决问题,除了第一个条目由于某种原因(评估公式按钮显示它正在工作,但最后它将值替换为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

答案 1 :(得分:0)

我调整了你必须包含一个数组所需的代码,这意味着你必须将你要求提供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