Excel vbaマクロを使用して連続番号のキーを生成

Question

Excel VBAマクロを使用して連続番号を生成できるかどうか疑問に思っています。

• AB_20050106_01：例えば、

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

  は、シーケンス内の次の項目を生成するために、Excel VBAマクロを使用することが可能です：

  私はこのような行を含むテキストファイルを持っています

• 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。 I. 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