请帮忙改一下代码

qmlyc1

以下是以年月日+序号的编码，请帮忙改成年月+序号，谢谢！Private Function 生成编号() As String On Error Resume Next '
    Dim theYear$, theMonth$, theDay$
    Dim theCell As Range, theFirstAddress$, theStrMaxNumNow$, theStrNum$
    theYear = Year(Date): theMonth = Format(Month(Date), "00"): theDay = Format(Day(Date), "00")
    theStrNum = "GS" & theYear & theMonth & theDay
    theStrMaxNumNow = "00"
    With ThisWorkbook.Worksheets("汇总表").Columns(3)
        Set theCell = .Cells.Find(what:=theStrNum, after:=.Cells(.Count), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False, SearchFormat:=False)
        If Not theCell Is Nothing Then
            theFirstAddress = theCell.Address
            Do
                If Right(theCell, 3) > theStrMaxNumNow Then theStrMaxNumNow = Right(theCell, 2)
                Set theCell = .FindNext(theCell)
            Loop Until theCell.Address = theFirstAddress
        End If
    End With
    生成编号 = "GS" & theYear & theMonth & theDay & Format(CVar(theStrMaxNumNow) + 1, "00")
End Function

qmlyc1

请老大们帮帮忙，谢谢！

ww87725244

把日去掉不就行了， theDay = Format(Day(Date), "00")

lsc900707

theYear = Year(Date): theMonth = Format(Month(Date), "00"): theDay = Format(Day(Date), "00")
theStrNum = "GS" & theYear & theMonth & theDay
改成：
theYear = Year(Date): theMonth = Format(Month(Date), "00")
theStrNum = "GS" & theYear & theMonth

qmlyc1

lsc900707 发表于 2018-9-17 22:06
theYear = Year(Date): theMonth = Format(Month(Date), "00"): theDay = Format(Day(Date), "00")
theStr ...

如何把后面的编号改成3位啊

oscarwmf

生成编号 = "GS" & theYear & theMonth & theDay & Format(CVar(theStrMaxNumNow) + 1, "000")

oscarwmf

不要日就改成
生成编号 = "GS" & theYear & theMonth &  Format(CVar(theStrMaxNumNow) + 1, "000")

qmlyc1

oscarwmf 发表于 2018-9-17 22:57
不要日就改成
生成编号 = "GS" & theYear & theMonth &  Format(CVar(theStrMaxNumNow) + 1, "000")

这样改后，第1、2号正确，之后就不能增加了

oscarwmf

Private Function 生成编号() As String
    On Error Resume Next '
    Dim theYear$, theMonth$
    Dim theCell As Range, theFirstAddress$, theStrMaxNumNow$, theStrNum$
    theYear = Year(Date): theMonth = Format(Month(Date), "00")
    theStrNum = "GS" & theYear & theMonth
    theStrMaxNumNow = "000"
    With ThisWorkbook.Worksheets("汇总表").Columns(3)
        Set theCell = .Cells.Find(what:=theStrNum, after:=.Cells(.Count), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False, SearchFormat:=False)
        If Not theCell Is Nothing Then
            theFirstAddress = theCell.Address
            Do
                If Right(theCell, 3) > theStrMaxNumNow Then theStrMaxNumNow = Right(theCell, 3)
                Set theCell = .FindNext(theCell)
            Loop Until theCell.Address = theFirstAddress
        End If
    End With
    生成编号 = "GS" & theYear & theMonth & Format(CVar(theStrMaxNumNow) + 1, "000")
End Function
最好上附件，我才好帮你改

wj2368

Private Function 生成编号() As String On Error Resume Next '
    Dim theYear$, theMonth$
    Dim theCell As Range, theFirstAddress$, theStrMaxNumNow$, theStrNum$
    theYear = Year(Date): theMonth = Format(Month(Date), "00")
    theStrNum = "GS" & theYear & theMonth
    theStrMaxNumNow = "000"
    With ThisWorkbook.Worksheets("汇总表").Columns(3)
        Set theCell = .Cells.Find(what:=theStrNum, after:=.Cells(.Count), LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False, SearchFormat:=False)
        If Not theCell Is Nothing Then
            theFirstAddress = theCell.Address
            Do
                If Right(theCell, 3) > theStrMaxNumNow Then theStrMaxNumNow = Right(theCell, 2)
                Set theCell = .FindNext(theCell)
            Loop Until theCell.Address = theFirstAddress
        End If
    End With
    生成编号 = "GS" & theYear & theMonth &  Format(CVar(theStrMaxNumNow) + 1, "000")
End Function