Jailson,
Boa Noite!
Essa função foi criada no VBA. Para rodar a mesma em outros arquivos, você deve acessar o editor do VBA desse arquivo que lhe enviei (ALT + F11), copiar a função e. no arquivo que você quer inserir a função, você deve, também no editor do VBA, inserir um Módulo (menu Inerir/Módulo) e colar a função.
Para maior esclarecimento de como o código da função procede, acrescentei comentários a cada linha de código da função e estou colnado abaixo para que você entenda melhor. Qualquer dúvida, amnde às ordens.
Function ContarCodigo(Codigo As Range) As Long
'Cria variáveis
Dim UltimaLinha, i, Soma, LinhaPlan2, Cod As Long
'Atribui a variável o número da linha onde está o código a ser procurado
LinhaPlan2 = Codigo.Row
'Procura a última linha com dados na planilha onde estão todos os os códigos. _
Essa procura é feita na Plan1,pela coluna A. Se o nome da aba for outro, basta _
trocar na linha abaixo Plan1 pelo nome que está na aba. Se os códigos estiverem _
em outra coluna diferente da A, troque o número 1 pelo número da coluna que quer.
UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, 1).End(xlUp).Row
'Aqui é apenas uma verificação para se certificar de que os dados da plan onde estão _
todos os códigos, começam na linha 1. Caso comecem em outra linha, basta trocar o 1 _
pelo número da linha onde começam os dados.
If UltimaLinha < 1 Then UltimaLinha = 1
'Esse laço percorre todas as linhas da planilha onde estão todos os códigos. Vai _
da linha 1 até a última linha encontrada acima. Se não começa na linha 1, isso deve _
ser modificado de modo a refletir o início onde começam os dados.
For i = 1 To UltimaLinha
'Aqui é feita a verificação para saber se o código que se quer procurar é igual aos códigos _
que estão sendo "varridos/procurados" pelo laço. A comparação busca um código que foi digitado _
na coluna A da Plan2 (se não for isso, basta alterar para o nome da aba que quer e para a coluna _
que quer. O código a ser comparado é checado, um a um com os códigos existentes na Plan1, na coluna _
A. Igualmente, se for diferente, basta modificar isso para o nome da aba e coluna onde estão _
os códigos.
If Sheets("Plan2").Range("A" & LinhaPlan2).Value = Sheets("Plan1").Range("A" & i).Value Then
'Se os códigos forem iguais, incrementa a variável soma para saber quantos são iguais
Soma = Soma + 1
End If
Next
'Finalmente,aqui é atribuído à função, o resultado encontrado para que o mesmo seja inserido na _
célula onde se colocou a função.
ContarCodigo = Soma
End Function
Postado : 15/01/2013 6:11 pm