Генерировать ключ с последовательными номерами при использовании макроса Excel vba

Question

Мне интересно, можно ли генерировать порядковый номер с помощью макроса Excel VBA.

У меня есть текстовый файл, который содержит следующую строку:

00|?????|AB_20050106_01||||||||||||||||||||||||||| 

Можно ли использовать Excel VBA макросов для создания следующего элемента в последовательности, например:

• AB_20050106_01
• AB_20050106_02
• AB_20050106_03
• ...

Когда я нажимаю кнопку в Excel?

В конечном счете, я хочу сохранить новый файл, в котором имя будет включать этот ключ, и я не хочу перезаписывать файлы.

Answer 1

Существует несколько вариантов отслеживания последовательности, но один из способов - сохранить личную переменную в модуле, на который вы можете ссылаться в других функциях. Это будет работать для индексов 01-99:

Option Explicit 

Const COUNTER_PREFIX As String = "AB_" 
Private m_lngCounter As Long 

Sub Test() 
    Dim i As Integer 

    For i = 1 To 100 
     Debug.Print GetNextCounterKey(Format(Now, "yyyyMMdd")) 
    Next 

End Sub 

Function GetNextCounterKey(strItem As String) As String 
    m_lngCounter = m_lngCounter + 1 
    GetNextCounterKey = COUNTER_PREFIX & strItem & "_" & Format(m_lngCounter, "00") 
End Function 

Answer 2

Вот идея о том, как идти об этом. Вам нужно будет отредактировать это, чтобы он точно соответствовал вашим потребностям, но должен сделать трюк. Разделите свой титул между ячейками; A1, B1, и C1. И.Е. A1 = AA, B1 = 22222222, C1 = 25 и назначьте макрос вызываемой кнопке.

Sub testing1() 
Dim Pt1 As String, Pt2 As Long, Pt3 As Long, FinalString As String 
'Get ranges from excel 
Pt1 = Range("A1").Value 
Pt2 = Range("B1").Value 
Pt3 = Range("C1").Value 

Pt3 = Pt3 + 1 
'Increment pt3 
If Pt3 = 100 Then 
    Pt3 = 0 
    Pt2 = Pt2 + 1 
    'Increment pt2/pt1 
    If Pt2 = 100000000 Then 
     Pt2 = 0 
     Select Case Len(Pt1) 
      Case 1 'char is one letter 
      If UCase(Pt1) = "Z" Then 
       Pt1 = "AA" 
      Else 
       Pt1 = Chr(Asc(Pt1) + 1) 
      End If  

      Case 2 'char is two letters 
      If Right(Pt1, 1) = "Z" Then 
       Pt1 = Chr(Asc(Left(Pt1, 1)) + 1) & "A" 
      Else 
       Pt1 = Left(Pt1, 1) & Chr(Asc(Right(Pt1, 1)) + 1) 
      End If 
     End Select  
    End If 
End If 

Pt2s = Format(Pt2, "00000000") 'Make 8 digits 
Pt3s = Format(Pt3, "00") 'Make 2 digits 
FinalString = Pt1 + "_" + Pt2s + "_" + Pt3s 

'Left these in here so you can see what is going on. 
MsgBox Pt1 
MsgBox Pt2 
MsgBox Pt3 
MsgBox FinalString 

'Set current vals to cells. 
Range("A1").Value = Pt1 
Range("B1").Value = Pt2s 
Range("C1").Value = Pt3s 

'Create File 
Set fs = CreateObject("Scripting.FileSystemObject") 
Set a = fs.CreateTextFile("c:\" + FinalString + ".txt", True) 
a.WriteLine ("Here is your first line.") 
a.Close 

End Sub