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であり、LAN-3になるには+1であることがわかります。トピックは以下のコードを持つ全て同じであったとき

I（トピックがすべて「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