MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    [Resolvido]Percorrer tabela, verificar e comparar registros.

    Compartilhe
    avatar
    biligo
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 10/04/2014

    [Resolvido]Percorrer tabela, verificar e comparar registros.

    Mensagem  biligo em Dom 23 Abr 2017, 09:06

    Boas galera,
    3 vez que tento abrir o tópico (Sempre crio acho que localizei o erro mas sempre dando voltas).

    A questão é que, tenho 2 tabelas, tblCardapio e tblCardapioReceita.
    Em uma determinada classificação do "Cardapio" tenho que ter itens específicos cadastrados na tblCardapioReceita.

    Fiz uma rotina para percorrer os itens cadastrados, até ai tudo bem identifico todos
    mas não estou conseguindo separar os que não estão cadastrados.

    Código:
       Dim rs As DAO.Recordset
        Dim IntX, Qnt As Integer
        Dim Aray(), Aray2() As String

        Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblCardapioReceita WHERE IdentCardapio = " & Me.IdCardapio & "")

        Do While Not rs.EOF 'Percorre todos os campos cuja condição seja valida
            For IntX = 75 To 76 'Verifica se o campo Produto é igual em algum dos casos
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    Strg = Strg & ", " & IntX 'Se for então grava na Strg
                End If
            Next
            For IntX = 146 To 148
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    Strg = Strg & ", " & IntX
                End If
            Next
            For IntX = 163 To 166
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    Strg = Strg & ", " & IntX
                End If
            Next
        rs.MoveNext
        Loop

    'Agora que percorreu e verificou todos os que estão cadastrados comparar

        st = ("75, 76, 146, 147, 148, 163, 164, 165, 166")
    Aray2() = Split(st, ",")
    [color=#ff0000]Aray() = Split(Strg, ",")[/color]
        For i1 = 1 To 9
            For i2 = 1 To 9
                If Aray2(i2) = Aray(i) Then
                    MsgBox "Este item esta na lista, " & Aray(i)
                    'Caso percorra todos os 9 registros e não localizar então
                    MsgBox "Este item não esta na lista, " & Aray(i)
                End If
            Next i2
        Next i1

    Até o ponto esta dando erro na linha destacada, acho que não é possível utilizar 2x seguidas o Split ou pelo menos nesse cado:
    Erro em tempo de execução 13. Tipos incompatíveis.
    Se utilizo 1x funciona.
    avatar
    biligo
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 207
    Registrado : 10/04/2014

    Re: [Resolvido]Percorrer tabela, verificar e comparar registros.

    Mensagem  biligo em Dom 23 Abr 2017, 23:48

    Booas galera,

    Dia todo mais consegui XD.
    É **** ser novato XD, segue abaixo a resolução que consegui.
    Agradeceria se alguém mais experiente pudesse dar uma olhada e apontar uma maneira mais pratica ou alguns macetes para diminuir a latência.

    Código:
    If Me.Classificacao = "HAMBURGUER" Then
       
        Dim rs As DAO.Recordset
        Dim IntX, Qnt As Integer

        Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblCardapioReceita WHERE IdentCardapio = " & Me.IdCardapio & "")

        Do While Not rs.EOF
            For IntX = 75 To 76
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    strg = strg & "," & IntX
                        C = Nz(C, 0) + 1
                End If
            Next
            For IntX = 146 To 148
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    strg = strg & "," & IntX
                        C = Nz(C, 0) + 1
                End If
            Next
            For IntX = 163 To 166
                If rs!Produto = IntX And rs!Tip = "PRODUTO" Then
                    strg = strg & "," & IntX
                        C = Nz(C, 0) + 1
                End If
            Next
        rs.MoveNext
        Loop

    If C < 9 Then
        For i = C To 8
            strg = strg & ",0"
                C = Nz(C, 0) + 1
        Next
    End If


        Dim List1() As String
        Dim List2() As String
            List1() = Split("75,76,146,147,148,163,164,165,166", ",")
            List2() = Split(strg, ",")
     
    For i = 0 To 8
        Cont = 0
        For i2 = 1 To 9
            If List2(i2) = List1(i) Then
                GoTo Nexti
            Else
                Cont = Cont + 1
            End If
           
                If Cont = 9 Then
                    If List1(i) = 146 Then
                        Qnt = "0,3"
                    ElseIf List1(i) = 75 Then
                        Qnt = 2
                    Else
                        Qnt = 1
                    End If
                        CurrentDb.Execute "INSERT INTO tblCardapioReceita " _
                          & "(IdentCardapio, Produto, Quantidade, Tip) VALUES " _
                          & "(" & Me.IdCardapio & "," & List1(i) & "," & Qnt & ", 'PRODUTO');"
                End If
        Next i2
    Nexti:
    Next i
        MsgBox "Fim"
    End If

      Data/hora atual: Qui 21 Set 2017, 02:29