Excel VBA独特的ID生成器

我正在尝试为讨论主题生成唯一的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

这个代码的诀窍，除了第一个条目（由于某种原因，评估公式button显示它正在工作，但在最后它用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