Este fórum está sendo desativado

[rit]

Bom dia,

Eu encontrei um procv na internet que me tras os itens em ordem, hoje o procv normal nos tras apenas a primeira ocorrencia com esse outro procv que eu achei eu consigo pegar a primeira, segunda etc... só que esse código esta travando de mais, ele funciona bem até, mas quando tem muitos dados ele trava tudo.. alguem consegue otimizar esse código? ou me dizer o que pode ser feito para melhorar o desempenho dele?

Código: Selecionar todos

Public Function PROCVN(Val1 As Variant, _
                       Table As Range, _
                       ResultCol As Integer, _
                       Optional Val1Occrnce As Integer = 1)
    Dim i As Integer
    Dim iCount As Integer
    Dim rCol As Range
        For i = 1 To Table.Rows.Count
        If Not (Application.WorksheetFunction.IsError(Table.Cells(i, 1))) Then
            If UCase(Table.Cells(i, 1)) = UCase(Val1) Then
                iCount = iCount + 1
            End If
            If iCount = Val1Occrnce Then
                PROCVN = Table.Cells(i, ResultCol)
                Exit For
                Else
                PROCVN = CVErr(xlErrNA)
            End If
        End If
        Next i
End Function

[babdallas]

Tentei melhorar o código. Veja o exemplo em anexo. Evidentemente que se tivermos milhares de linhas o resultado pode sim demorar muito, pois ele percorre linha a linha.

Código: Selecionar todos

Public Function PROCVN(Val1 As Variant, _
                       Table As Range, _
                       ResultCol As Long, _
                       Optional Val1Occrnce As Long = 1)
                       
    Static vrtDados     As Variant
    Dim i               As Long
    Dim iCount          As Long
    Dim rngInt          As Range
    
    Set rngInt = Application.Intersect(Table, Planilha1.UsedRange)
    If Not VBA.IsArray(vrtDados) Then
        vrtDados = rngInt.Value
    End If
    
        For i = LBound(vrtDados, 1) To UBound(vrtDados, 1)
            If Not (VBA.IsError(vrtDados(i, 1))) Then
                If VBA.UCase(vrtDados(i, 1)) = VBA.UCase(Val1) Then iCount = iCount + 1

                If iCount = Val1Occrnce Then
                    PROCVN = vrtDados(i, ResultCol)
                    Exit For
                Else
                    PROCVN = CVErr(xlErrNA)
                End If
            End If
        Next i
End Function

[JCabral]

Como é possível usar esta função?

[babdallas]

É um Procv que no último argumento você pode escolher se quer retornar a 1a, 2a, 3a correspondência, etc. Se não tiver a correspondência, retornar erro de não disponível.

[SandroLima]

Poderia mandar uma planilha com o exemplo na prática?

[babdallas]

Editei a primeira mensagem. Mudei um pouco o código para não deixar lento demais caso se escolha a coluna toda. Também anexei um exemplo lá. Lembrando que o código não é meu. Apenas adaptei para ficar menos lento.