MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Gerar ARRANJO de letras e números

    annissima
    annissima
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 169
    Registrado : 24/10/2017

    [Resolvido]Gerar ARRANJO de letras e números Empty [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  annissima 13/3/2021, 16:35

    Olá,

    Estou tentando criar uma combinação de letras e números, aleatoriamente, e encontrei um código que até faz isso, mas ele gera todas as possibilidades, enquanto eu gostaria que ele gerasse até encontrar um código novo, e parasse ali.

    A usabilidade será gerar um código aleatório para um produto.
    Não quero um número sequencial, quero algo de fato aleatório, com um comprimento fixo de caracteres.
    Assim, por exemplo, podemos ter:

    P00AAA

    Onde a letra P seria de produto
    00 uma combinação de 2 números (de 0 a 9)
    AAA uma combinação de 3 letras (de A a Z)

    Assim terei em um campo curto (6 dígitos) uma quantidade razoável de possibilidades

    Encontrei o seguinte código, e venho testando em uma tabela para inserir os resultados.
    No entanto, a fórmula executa TODAS as possibilidades, enquanto eu quero que ela PARE de executar assim que encontrar um valor novo.

    Por exemplo, se na tabela produtos já existir o produto P00AAA, ele continua gerando, e vai para o P00AAB por exemplo.
    Aí ele vê que o P00AAB não existe na tabela produto, retorna essa string para eu usar, e sai da função.


    Código:
    Option Compare Database
    Option Explicit


    'C(n, p) = n! / ((n-p)! * p!)
    'nPermutações a ser definido, seria o 'p' da fórmula acima

    Dim h(1 To 10)


    Public Function PopularArranjo(nElementos As Long, nPermutações As Long)
      
      
      ' Dim lElementos As Long
        'Popula vetor de elementos
     
       h(1) = "A"
        h(2) = "B"
        h(3) = "C"
        h(4) = "D"
        h(5) = "E"
        h(6) = "F"
        h(7) = "G"
        h(8) = "H"
        h(9) = "I"
        h(10) = "J"
        
        'C(n, p) = n! / ((n-p)! * p!)
        'lElementos seria o 'n' da fórmula acima
        nElementos = UBound(h) - LBound(h) + 1
          
        'Inicia recursão:
        Combinação nElementos, nPermutações, 1
        
    End Function


    Public Function Combinação(n As Long, p As Long, k As Long, Optional s As String)

    Dim checkStr As String

        If p > n - k + 1 Then Exit Function
        If p = 0 Then
                            
                            If IsNull(DLookup("[arranjo]", "[tblArranjosss]", "[arranjo] = '" & s & "'")) Then
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL "INSERT INTO tblArranjosss (arranjo) values ('" & s & "')"
                                DoCmd.SetWarnings True

                            End If

            Exit Function
        End If
        

        'Recorre novamente:
        Combinação n, p - 1, k + 1, s & v(k)
        'Recorre novamente a partir do elemento anterior:
        Combinação n, p, k + 1, s
            
    End Function
        
    crysostomo
    crysostomo
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 50%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1715
    Registrado : 23/01/2018

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  crysostomo 13/3/2021, 17:30

    Coloque a função do randow Rondon
    El3 vai rondomizar e jogar aleatoriamente


    .................................................................................
    Uma mão ajuda a outra.
    Feliz aquele que transfere o que sabe e aprende o que ensina.
    annissima
    annissima
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 169
    Registrado : 24/10/2017

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  annissima 13/3/2021, 17:31

    Hey

    Consegui da seguinte forma:

    Código:
    Public Function RandomizeL(Num1 As Integer, Num2 As Integer)

    Dim Rand As String, getLen As String, I As Integer
    getLen = Int((Num2 + 1 - Num1) * Rnd + Num1)
    Do
        I = I + 1
        Randomize
        Rand = Rand & Chr(Int((26) * Rnd + 65))
    Loop Until I = getLen
    RandomizeL = Rand

    End Function

    Public Function RandomizeN(Num1 As Integer, Num2 As Integer)
    Dim Rand As String, getLen As String, I As Integer
    getLen = Int((Num2 + 1 - Num1) * Rnd + Num1)
    Do
        I = I + 1
        Randomize
        Rand = Rand & Chr(Int((10) * Rnd + 48))
    Loop Until I = getLen
    RandomizeN = Rand
    End Function

    crysostomo gosta desta mensagem

    crysostomo
    crysostomo
    Maximo VIP
    Maximo VIP

    Respeito às regras : Respeito às Regras 50%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1715
    Registrado : 23/01/2018

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  crysostomo 13/3/2021, 17:33

    Sucesso


    .................................................................................
    Uma mão ajuda a outra.
    Feliz aquele que transfere o que sabe e aprende o que ensina.
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 22/11/2016

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  DamascenoJr. 18/3/2021, 01:14

    Vale ressaltar que isso pode ser ruim para o desempenho do banco de dados a medida que a tabela de produtos cresce em número de registros.

    Digamos que para um novo registro seja gerado um determinado código, com isso uma viagem é feita para conferir se o código já foi utilizado antes, se sim, um novo código é gerado, com isso uma nova viagem é feita para conferir se o código já foi gerado, se sim, novo código, nova viagem, se usado, novo código, nova viagem etc etc etc.

    A ideia de número sequencial é evitar muitas visitas a tabela, bastando apenas buscar o maior e adicionar uma unidade.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    annissima
    annissima
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 169
    Registrado : 24/10/2017

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  annissima 18/3/2021, 01:20

    Eu sei. Mas me incomoda DEMAAAAAAIIIISSS ter numeros com comprimentos diferentes... 1, 10, 1000.. aí meus campos ficam desalinhados kkkkkkk

    tá, eu sou louca.
    obrigada kkkk

    Irae Veras gosta desta mensagem

    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 22/11/2016

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  DamascenoJr. 18/3/2021, 01:24

    Na folha de propriedades tanto da tabela quando do formulário existe a propriedade formato. Com isso basta indicar com 0 (zeros) o comprimento desejado.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.

    crysostomo gosta desta mensagem

    annissima
    annissima
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 169
    Registrado : 24/10/2017

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  annissima 18/3/2021, 01:26

    Aí eu não gosto de registros com um monte de zeros...
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2816
    Registrado : 22/11/2016

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  DamascenoJr. 18/3/2021, 01:32

    Bom, apenas registrei o possível problema de desempenho que poderá ocorrer no futuro.

    No fim, o desenvolvedor que decide.


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    annissima
    annissima
    Intermediário
    Intermediário

    Respeito às regras : Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 169
    Registrado : 24/10/2017

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  annissima 18/3/2021, 01:49

    Uso esse codigo para clientes e números de processo.
    Improvável que um advogado tenha mais que mil clientes num escritório pequeno...
    Nesse caso eu vou escalar o sistema para algo maior...

    Tô aprendendo SQL tbm Smile
    Coloquei algumas coisas na nuvem e fiz uma conexao ODBC
    avatar
    Cleriston
    Novato
    Novato

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Anónimo
    Mensagens : 1
    Registrado : 30/08/2011

    [Resolvido]Gerar ARRANJO de letras e números Empty Re: [Resolvido]Gerar ARRANJO de letras e números

    Mensagem  Cleriston 20/3/2021, 22:55

    Olá!

    Sou novo aqui no fórum, mas é possível vc gerar esse código na sequência.

    Tenho um código parecido, fiz uma adaptação pra sua necessidade.

    Basta criar uma tabela com apenas um campo pra guardar o último código utilizado. Essa tabela terá sempre apenas um registro, então toda vez que for gerar um novo consulte essa tabela e faça o update desse único registro.

    No exemplo abaixo, toda vez que vc chamar a função 'ProxCodigoProdutoP_Tabela' um novo código na sequência será entregue.

    Código:

    Function ProxCodMatriz(ByVal Codigo As String, ByVal Matriz As String) As String
    'Esta funçao determina o próximo código de uma matriz ordenada,
    'considerando o números de dígitos do código inicial.
    'Exemplos de matrizes: 0123456789ABCDEFGQRSTVWXZ (alfa-numérico números + letras da mão esquerda) - 25 Dígitos
    '                      0123456789ABCDEF (hexadecimal) - 16 Dígitos
    '                      0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ (alfa-numérico completo) - 36 Dígitos
    '------------------------------------------------------------------------------------------------
    'Tratamento de ERROS
    On Error GoTo TratamentoErros_Erro

    Dim TamanhoDaMatriz, Digito, QuantDigitos, Posicao As Byte
    Dim DigitoAnalisado As String
    Dim NovoCodigo As String

    TamanhoDaMatriz = Len(Matriz)
    QuantDigitos = Len(Codigo)

    For Digito = 1 To QuantDigitos

        DigitoAnalisado = Mid(Codigo, QuantDigitos - (Digito - 1), 1)
        Posicao = InStr(Matriz, DigitoAnalisado)
        
        If Posicao = TamanhoDaMatriz Then
            Posicao = 0
        ElseIf Posicao = 0 Then
            GoTo ResultadoInvalido
            Exit For
        Else
            NovoCodigo = Mid(Matriz, Posicao + 1, 1) & NovoCodigo
            Exit For
        End If

        NovoCodigo = Mid(Matriz, Posicao + 1, 1) & NovoCodigo

    Next

    NovoCodigo = Left(Codigo, Len(Codigo) - Len(NovoCodigo)) & NovoCodigo

    ProxCodMatriz = UCase(NovoCodigo)


    ProxCodMatrizNum_Exit:
        Exit Function

    ResultadoInvalido:
    ProxCodMatriz = "Matriz Inválida para o código: " & DigitoAnalisado

    '-----------------------------------------------------------------------------------------------------------------------
    TratamentoErros_Exit:
        Exit Function

    TratamentoErros_Erro:
        ProxCodMatriz = "#Erro"
        Resume TratamentoErros_Exit
    '-----------------------------------------------------------------------------------------------------------------------

    End Function



    Function ProxCodProdutoP(codProdutoP As String) As String

    Dim seqNum As Integer
    Dim seqAlfa As String

    If Len(codProdutoP) = 6 And Left(codProdutoP, 1) = "P" Then

        seqNum = Mid(codProdutoP, 2, 2)
        seqAlfa = Mid(codProdutoP, 4, 3)
        
        seqAlfa = ProxCodMatriz(seqAlfa, "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
        
        If seqAlfa = "AAA" Then
            seqNum = seqNum + 1
                If seqNum > 99 Then
                    seqNum = 0
                End If
        End If
        
        ProxCodProdutoP = UCase("P" & Format(seqNum, "00") & seqAlfa)

    End If

    ProxCodProdutoP_Exit:
        Exit Function

    '-----------------------------------------------------------------------------------------------------------------------
    TratamentoErros_Exit:
        Exit Function

    TratamentoErros_Erro:
        ProxCodProdutoP = "#Erro"
        Resume TratamentoErros_Exit
    '-----------------------------------------------------------------------------------------------------------------------

    End Function


    Function ProxCodigoProdutoP_Tabela() As String

    Dim novoCodigo As String
    Dim rsUltimoCodP As DAO.Recordset

    Set rsUltimoCodP = CurrentDb.OpenRecordset("tabUltimoCodP")

    novoCodigo = ProxCodProdutoP(rsUltimoCodP!UltimoCodP)

    rsUltimoCodP.Edit
        rsUltimoCodP!UltimoCodP = novoCodigo
    rsUltimoCodP.Update

    ProxCodigoProdutoP_Tabela = novoCodigo

    rsUltimoCodP.Close
    Set rsUltimoCodP = Nothing

    End Function

      Data/hora atual: 16/6/2021, 15:47