[Resolvido]Gerar ARRANJO de letras e números

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
    

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

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


Sucesso

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.

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

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.

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

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

No fim, o desenvolvedor que decide.

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
Coloquei algumas coisas na nuvem e fiz uma conexao ODBC

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