问题描述:

I am wondering if it is possible to generate a sequential number using Excel VBA macro.

I have a text file which contains a line like this:

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

Is it possible to use Excel VBA macro to generate the next item in the sequence, for example:

  • AB_20050106_01
  • AB_20050106_02
  • AB_20050106_03
  • ...

Whenever i press a button in Excel?

Ultimately, I want to save a new file where the name will include this key and I don't want to overwrite files.

网友答案:

There's a few options to keep track of the sequence but one way is to keep a private variable in a module that you can refer to in other functions. This will work for indices 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
网友答案:

Here is an idea on how to go about it. You'll need to edit this to fit exactly to your needs however, should do the trick. Break your title apart across cells; A1, B1, and C1. I.E. A1 = AA, B1 = 22222222, C1 = 25 and assign the macro to a button to be called.

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
相关阅读:
Top