[Resolvido]numeração complementar

Boa Tarde à todos.
Mais uma vez venho recorrer aos ilustres colegas.
Estou com um dilema que está me parecendo um tanto quanto complicado, explico
Tenho uma tabela "CONT PRINC", nela tenho os campos "PTRALT", "INC", "IDPER" e "INCALT", pois bem.
O que estou tentando conseguir é:
Um módulo que faça o seguinte:
O Campo referencia e ao qual temos que se basear é o "PTRALT".
Ele se repete por vezes e é no agrupamento dele é que temos que trabalhar.
A coluna "INC" está preenchida com "00000"; "99999" e outros números.
Onde está preenchida com "0000" a coluna "IDPER" está preenchida com "M1"
Para os números "99999" e outros a coluna "IDPER" está preenchida com "B2".
O que preciso é:
Na coluna "INCALT" seja preenchido com a seguinte numeração, Isso sendo por "PTRALT"
EX.:

PTRALT    INC      IDPER    INCALT
10           00000    M1        00000
10           00022    B2        00022
10           00025    B2        00025
10           99999    B2        00026
10           99999    B2        00027

Ou seja:

O Módulo deverá preencher a coluna INCALT
Para o IDPER M1 terá que se manter o 00000
Onde há outros números terão que ser mantidos os mesmos números
E onde há o 99999 o módulo deverá ver qual o maior número existente para aquele PTRALT e continuar a sequencia.
Lembrando que isso deve ser feito por PTRALT.

Anexo arquivo para os devidos testes

Desde já agradeço imensamente a atenção de todos

Boa noite,
execute este procedimento

Código:

Sub Preenche()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Rst As DAO.Recordset
    Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [CONT PRINC]")
    Rst.MoveFirst
    Do While Not Rst.EOF
        Select Case Rst("INC")
        Case "99999"
            Rst.Edit
            'Rst("INCALT") = intNr
            Rst("INCALT") = DMax("INCALT", "[CONT PRINC]", "PTRALT='" & Rst("PTRALT") & "'") + 1
            Rst.Update
        End Select
        Rst.MoveNext
    Loop
    Set Rst = Nothing
End Sub

Grande Alexandre. Bom dia.
Em primeiro lugar, agradeço muito a sua pronta ajuda.
Mas estou tentando executar o seu código, porém ele fica, fica, fica,fica executando até o programa não responder.
O que pode estar acontecendo???

Boa tarde,
Ele demora porque tem que percorrer muitos registos e ser chamada a função DMax mas funcionará

Alexandre.
O módulo rodou mas não funcionou de maneira correta.
Veja no arquivo em anexo onde há o código enviado por voce, o exemplo do PTRALT 0000023554450000
Ele não manteve os números que estavam na coluna INC e onde tinha 99999 ele preencheu diversos itens com 1000

Exemplo

PTRALT                        INC          INCALT
0000023554450000      00000      00000
0000023554450000      00023      00023
0000023554450000      00024      00024
0000023554450000      00055      00055
0000023554450000      00056      00056
0000023554450000      99999      00057
0000023554450000      99999      00058
0000023554450000      99999      00059

Grato

Boa tarde,
Não alterei a coluna INC, como verá no código

Criei novo código que julgo atender, se não der, indique com mais detalhe as situações de verificação

Código:

Sub Preenche()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Rst As DAO.Recordset, strPtRalt As String, intNR As Integer
    Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [CONT PRINC] ORDER BY PTRALT, INC,INCALT")
    Rst.MoveFirst
    Do While Not Rst.EOF
        If Rst("PTRALT") <> strPtRalt Then
            strPtRalt = Rst("PTRALT")
            intNR = 0
        End If
        Select Case Rst("INC")
        Case "99999"
            intNR = intNR + 1
            Rst.Edit
            Rst("INCALT") = intNR
            Rst.Update
        Case Else
            intNR = Rst("INCALT")
        End Select
        Rst.MoveNext
    Loop
    Set Rst = Nothing
End Sub

Alexandre

Rodei esse novo módulo, mas ainda não está a funcionar.
Vou tentar ser mais claro quanto a metodologia

Para o exemplo abaixo, o original está assim

PTRALT INC INCALT
0000023554450000 00000 00000
0000023554450000 00023 00000
0000023554450000 00024 00000
0000023554450000 00055 00000
0000023554450000 00056 00000
0000023554450000 99999 00000
0000023554450000 99999 00000
0000023554450000 99999 00000

Devendo ficar assim

PTRALT INC INCALT
0000023554450000 00000 00000
0000023554450000 00023 00023
0000023554450000 00024 00024
0000023554450000 00055 00055
0000023554450000 00056 00056
0000023554450000 99999 00057
0000023554450000 99999 00058
0000023554450000 99999 00059

Ou seja a transformação deverá ocorrer na coluna INCALT

A quebra será por PTRALT

Para o item onde a coluna INC estiver preenchida com "00000" a INCALT deverá ser "00000"
Para o item onde a coluna INC estiver preenchida com "qualquer número" a INCALT deverá ser igual
Exemplo acima INC 00023 INCALT 00023
Para os itens onde a coluna INC estiver preenchida com "99999" deverá ver qual o maior numero na coluna INCALT e dar sequancia a numeração
Exemplo acima INCALT "00056" maior número, sequencia "00057", "00058", "00059"
O preenchimento da INCALT onde a INC esteja "99999" deverá ocorrer por último
Lembro que esse processo deverá ser feito em cada PTRALT

Se não estiver claro me diga por favor

Desde já agradeço

Veja agora,

Código:

Sub Preenche()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Rst As DAO.Recordset, strPtRalt As String, intNR As Integer
    Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [CONT PRINC] ORDER BY PTRALT, INC,INCALT")
    Rst.MoveFirst
    Do While Not Rst.EOF
        If Rst("PTRALT") <> strPtRalt Then
            strPtRalt = Rst("PTRALT")
            intNR = 0
        End If
        Select Case Rst("INC")
        Case "99999"
            intNR = intNR + 1
            Rst.Edit
            Rst("INCALT") = intNR
            Rst.Update
        Case "00000"
        Case Else
            Rst.Edit
            Rst("INCALT") = Rst("INC")
            Rst.Update
            intNR = Rst("INCALT")
        End Select
        Rst.MoveNext
    Loop
    Set Rst = Nothing
End Sub



Grande Alexandre, bom dia.

Agora está perfeito.
Só um detalhe, sem querer ser chato, mas já sendo.
Tem como ele , ao preencher a numeração coloca-la no tamanho de 5 casas?
Exemplo:

"00057", "01238" , "00002"

Muito obrigado

Bom dia,
Use

Código:

Sub Preenche()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim Rst As DAO.Recordset, strPtRalt As String, intNR As Integer
    Set Rst = CurrentDb.OpenRecordset("SELECT * FROM [CONT PRINC] ORDER BY PTRALT, INC,INCALT")
    Rst.MoveFirst
    Do While Not Rst.EOF
        If Rst("PTRALT") <> strPtRalt Then
            strPtRalt = Rst("PTRALT")
            intNR = 0
        End If
        Select Case Rst("INC")
        Case "99999"
            intNR = intNR + 1
            Rst.Edit
            Rst("INCALT") = Format(intNR, "00000")
            Rst.Update
        Case "00000"
        Case Else
            Rst.Edit
            Rst("INCALT") = Rst("INC")
            Rst.Update
            intNR = Rst("INCALT")
        End Select
        Rst.MoveNext
    Loop
    Set Rst = Nothing
End Sub


Alexandre.

Está perfeito.
É muito bom poder contar com pessoas como você, dispostas a ajudar.
Estou dando o tópico como resolvido.
Mais uma vez, muito obrigado e até uma próxima.