ทำเลขรัน (Auto Number) ให้นับหนึ่งใหม่เมื่อเข้าเดือนใหม่ ต้องปรับเพิ่มแก้สูตรอย่างไรครับ

[10idlnw]

ตอนนี้ผมทำให้มันรันเรื่อยๆตามต้องการได้แล้ว แต่อยากให้มันมาเริ่มที่ 0001 ใหม่เมื่อเข้าเดือนใหม่โดยอัตโนมัติ ต้องปรับแก้เพิ่มสูตรอย่างไรครับ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

        Dim cell As Range
        Application.EnableEvents = False
        For Each cell In Target
            If Not Application.Intersect(cell, Range("InputC_RunN")) Is Nothing Then
               If Not IsNumeric(cell.Value) Then
                  cell.Value = vbNullString
               End If
            End If
        Next cell
        Application.EnableEvents = True
    
        If Not Intersect(Target, [InputC_Y]) Is Nothing Then
                If [InputC_Y] <> [MyNow_Y_Sprit] Then Range("InputC_Y").Value = [MyNow_Y_Sprit]
        End If

        If Not Intersect(Target, [InputC_M]) Is Nothing Then
                If [InputC_M] <> [MyNow_M] Then Range("InputC_M").Value = [MyNow_M]
        End If

        
        If Not Intersect(Target, [InputC_RunN]) Is Nothing Then
                Application.EnableEvents = False
                
                Range("InputC_RunN") = Replace([InputC_RunN], "+", "")
                
                If [InputC_RunN] > 9999 Then
                    Range("InputC_RunN") = Range("InputC_RunN") + 1
                End If
                
                If [InputC_RunN] = 0 Then
                    Range("InputC_RunN") = Range("InputC_RunN") + 1
                End If
                
                    Call PadRunN
                    Range("InputC_RunN") = [InputC_RunN]
                Application.EnableEvents = True
        End If

End Sub

Private Sub CommandButton1_Click()
        Dim nameSvFile As String
        Dim PathDir As String
        Dim strFileExists As String
                
        PathDir = ThisWorkbook.Path & "\"
        nameSvFile = PathDir & [SetName4NewFile] & ".xlsm"
        strFileExists = PathDir & [SetName4NewFile] & "*"

                
        If Dir(strFileExists) <> "" Then

                MsgBox "หมายเลขนี้ถูกสร้างแล้ว กรุณาเลือกหมายเลขใหม่ !"
                Range("InputC_RunN") = Range("InputC_RunN") + 1

        Else
        
                Range("InputC_RunN") = Range("InputC_RunN") + 1
                    MsgBox "สร้างไฟล์ " & nameSvFile & " สำเร็จ"

        End If
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

'Other code
If VBA.Month(Date) = VBA.Month(Date - 1) Then
    Range("InputC_RunN") = Range("InputC_RunN") + 1
Else
    Range("InputC_RunN") = 1
End If
'Other code

[10idlnw]

ขอบคุณมากครับอาจารย์ แล้วโดยไม่ต้องรอถึงเดือนหน้า ผมต้องทดสอบยังไงว่าโค้ดเป็นไปตามสิ่งที่ต้องการแล้วครับ

[snasui]

Date คือวันที่ปัจจุบัน

Date - 1 คือ 1 วันก่อนหน้า ถ้าต้องการตรวจสอบ Code ก็เปลี่ยน - 1 เป็นค่าใด ๆ ตามต้องการครับ

[10idlnw]

เอาไปปรับใช้ได้ลงตัวแล้วครับ ขอบคุณมากครับอาจารย์