none
Erro em Tempo de Execução '1004 -> Vlookup da Classe WorksheetFunction RRS feed

  • Pergunta

  • Pessoal, bom dia!

    Estou precisando de uma ajudinha, não estou conseguindo detectar o erro na procura via Vlookup:

    Segue:

    Private Sub Cb_SubCad_Change()

    'On Error Resume Next

    Dim CentroCusto As String
    Dim Disciplina As String
    Dim Documento As String
    Dim SubArea As String
    Dim SeqPen As String
    Dim SeqFinal As String

    CentroCusto = Application.WorksheetFunction.VLookup(Cb_CCCad.Text, Sheets("TB_Obra").Range("B1:E10000"), 4, False)
    Documento = Cb_DocCad.Text
    Disciplina = Application.WorksheetFunction.VLookup(Cb_DiscCad.Text, Sheets("TB_Disciplina").Range("B1:E10000"), 4, False)
    SubArea = Application.WorksheetFunction.VLookup(Cb_SubCad.Text, Sheets("TB_SubArea").Range("B1:E10000"), 4, False)
    SeqPen = Format(CentroCusto, "0000") & "-" & Documento & "-" & Format(Disciplina, "0000") & "-" & Format(SubArea, "0000")

    txt_SeqCad = SeqPen

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    O erro apresenta aqui, observe que pego o resultado da concatenação da variável SeqPen e adiciono ao txt_SeqCad, que por último realizo a pesquisa abaixo. E é nessa pesquisa que dá o erro.

    Coloquei abaixo o Erro, e o teste que fiz inserindo diretamente o resultado no arg1. Esse teste deu certo. Entretanto, apresenta o erro quando pego diretamente do txt_SeqCad.

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Erro: SeqFinal = Application.WorksheetFunction.VLookup(txt_SeqCad.Text, Sheets("TB_Cod_Final").Range("D1:E10000"), 2, False)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Teste: SeqFinal = Application.WorksheetFunction.VLookup("001-MN-001-001", Sheets("TB_Cod_Final").Range("D1:E10000"), 2, False)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        txt_SeqCad.Text = Empty

       txt_SeqCad.Text = SeqFinal

    End Sub

    terça-feira, 15 de setembro de 2020 14:03

Respostas

  • Private Sub Cb_SubCad_Change()
    
    'On Error Resume Next
    
    Dim CentroCusto As String
    Dim Disciplina As String
    Dim Documento As String
    Dim SubArea As String
    Dim SeqPen As String
    Dim SeqFinal As Range
    
    CentroCusto = Application.WorksheetFunction.VLookup(Cb_CCCad.Text, Sheets("TB_Obra").Range("B1:E10000"), 4, False)
    Documento = Cb_DocCad.Text
    Disciplina = Application.WorksheetFunction.VLookup(Cb_DiscCad.Text, Sheets("TB_Disciplina").Range("B1:E10000"), 4, False)
    SubArea = Application.WorksheetFunction.VLookup(Cb_SubCad.Text, Sheets("TB_SubArea").Range("B1:E10000"), 4, False)
    SeqPen = Format(CentroCusto, "0000") & "-" & Documento & "-" & Format(Disciplina, "0000") & "-" & Format(SubArea, "0000")
    
    txt_SeqCad = SeqPen
    
    
    Set SeqFinal = PNL_CodFinal.Range("D1:E10000")
    
    Me.txt_ResCad.Text = WorksheetFunction.VLookup(Me.txt_SeqCad.Text, SeqFinal, 2, 0)
    
    
    End Sub
    
    Private Sub UserForm_Initialize()
    
    Application.ScreenUpdating = False
    
    Application.Calculation = xlCalculationManual
    
    Application.EnableEvents = False
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha As Integer, Final As Integer, Registro As Integer
    
       Linha = 2
        Do While PNL_Obra.Cells(Linha, 2) <> ""
            Linha = Linha + 1
        Loop
    
        Final = Linha - 1
        With PNL_Obra
            For Linha = 2 To Final
            Registro = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha, 2)), .Cells(Linha, 2))
                If Registro = 1 Then
                Cb_CCCad.AddItem .Cells(Linha, 2)
                
                End If
            Next Linha
        End With
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha2 As Integer, Final2 As Integer, Registro2 As Integer
    
       Linha2 = 2
        Do While PNL_Doc.Cells(Linha2, 2) <> ""
            Linha2 = Linha2 + 1
        Loop
    
        Final2 = Linha2 - 1
        With PNL_Doc
            For Linha2 = 2 To Final2
            Registro2 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha2, 2)), .Cells(Linha2, 2))
                If Registro2 = 1 Then
                Cb_DocCad.AddItem .Cells(Linha2, 2)
                
                End If
            Next Linha2
        End With
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha3 As Integer, Final3 As Integer, Registro3 As Integer
    
       Linha3 = 2
        Do While PNL_Disciplina.Cells(Linha3, 2) <> ""
            Linha3 = Linha3 + 1
        Loop
    
        Final3 = Linha3 - 1
        With PNL_Disciplina
            For Linha3 = 2 To Final3
            Registro3 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha3, 2)), .Cells(Linha3, 2))
                If Registro3 = 1 Then
                Cb_DiscCad.AddItem .Cells(Linha3, 2)
                
                End If
            Next Linha3
        End With
    
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha7 As Integer, Final7 As Integer, Registro7 As Integer
    
       Linha7 = 2
        Do While PNL_SubArea.Cells(Linha7, 2) <> ""
            Linha7 = Linha7 + 1
        Loop
    
        Final7 = Linha7 - 1
        With PNL_SubArea
            For Linha7 = 2 To Final7
            Registro7 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha7, 2)), .Cells(Linha7, 2))
                If Registro7 = 1 Then
                Cb_SubCad.AddItem .Cells(Linha7, 2)
                
                End If
            Next Linha7
        End With
    
    
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    terça-feira, 15 de setembro de 2020 15:53

Todas as Respostas

  • Está apresentando erro de tempo de execução '13" -> Tipos Incompatíveis

    O código final que pega do textbox é -> 001-MN-001-001 (Letras e Números misturados) <-Vem de uma concatenação.

    terça-feira, 15 de setembro de 2020 14:38
  • Pronto, envei
    terça-feira, 15 de setembro de 2020 15:12
  • Private Sub Cb_SubCad_Change()
    
    'On Error Resume Next
    
    Dim CentroCusto As String
    Dim Disciplina As String
    Dim Documento As String
    Dim SubArea As String
    Dim SeqPen As String
    Dim SeqFinal As Range
    
    CentroCusto = Application.WorksheetFunction.VLookup(Cb_CCCad.Text, Sheets("TB_Obra").Range("B1:E10000"), 4, False)
    Documento = Cb_DocCad.Text
    Disciplina = Application.WorksheetFunction.VLookup(Cb_DiscCad.Text, Sheets("TB_Disciplina").Range("B1:E10000"), 4, False)
    SubArea = Application.WorksheetFunction.VLookup(Cb_SubCad.Text, Sheets("TB_SubArea").Range("B1:E10000"), 4, False)
    SeqPen = Format(CentroCusto, "0000") & "-" & Documento & "-" & Format(Disciplina, "0000") & "-" & Format(SubArea, "0000")
    
    txt_SeqCad = SeqPen
    
    
    Set SeqFinal = PNL_CodFinal.Range("D1:E10000")
    
    Me.txt_ResCad.Text = WorksheetFunction.VLookup(Me.txt_SeqCad.Text, SeqFinal, 2, 0)
    
    
    End Sub
    
    Private Sub UserForm_Initialize()
    
    Application.ScreenUpdating = False
    
    Application.Calculation = xlCalculationManual
    
    Application.EnableEvents = False
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha As Integer, Final As Integer, Registro As Integer
    
       Linha = 2
        Do While PNL_Obra.Cells(Linha, 2) <> ""
            Linha = Linha + 1
        Loop
    
        Final = Linha - 1
        With PNL_Obra
            For Linha = 2 To Final
            Registro = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha, 2)), .Cells(Linha, 2))
                If Registro = 1 Then
                Cb_CCCad.AddItem .Cells(Linha, 2)
                
                End If
            Next Linha
        End With
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha2 As Integer, Final2 As Integer, Registro2 As Integer
    
       Linha2 = 2
        Do While PNL_Doc.Cells(Linha2, 2) <> ""
            Linha2 = Linha2 + 1
        Loop
    
        Final2 = Linha2 - 1
        With PNL_Doc
            For Linha2 = 2 To Final2
            Registro2 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha2, 2)), .Cells(Linha2, 2))
                If Registro2 = 1 Then
                Cb_DocCad.AddItem .Cells(Linha2, 2)
                
                End If
            Next Linha2
        End With
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha3 As Integer, Final3 As Integer, Registro3 As Integer
    
       Linha3 = 2
        Do While PNL_Disciplina.Cells(Linha3, 2) <> ""
            Linha3 = Linha3 + 1
        Loop
    
        Final3 = Linha3 - 1
        With PNL_Disciplina
            For Linha3 = 2 To Final3
            Registro3 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha3, 2)), .Cells(Linha3, 2))
                If Registro3 = 1 Then
                Cb_DiscCad.AddItem .Cells(Linha3, 2)
                
                End If
            Next Linha3
        End With
    
    
       'Carrega valores únicos em uma lista com valores duplicados
       Dim Linha7 As Integer, Final7 As Integer, Registro7 As Integer
    
       Linha7 = 2
        Do While PNL_SubArea.Cells(Linha7, 2) <> ""
            Linha7 = Linha7 + 1
        Loop
    
        Final7 = Linha7 - 1
        With PNL_SubArea
            For Linha7 = 2 To Final7
            Registro7 = WorksheetFunction.CountIf(.Range(.Cells(2, 2), .Cells(Linha7, 2)), .Cells(Linha7, 2))
                If Registro7 = 1 Then
                Cb_SubCad.AddItem .Cells(Linha7, 2)
                
                End If
            Next Linha7
        End With
    
    
    End Sub
    


    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    terça-feira, 15 de setembro de 2020 15:53
  • Muito obrigado.
    terça-feira, 15 de setembro de 2020 15:57