Notifications
Clear all

Contar Ocorrência em banco - VBA

8 Posts
2 Usuários
0 Reactions
2,073 Visualizações
chook
(@chook)
Posts: 197
Estimable Member
Topic starter
 

Bom dia amigos,
tenho uma planilha que é alimentada com as vendas, e nela podemos ter repetido várias vezes o mesmo cliente.
Estou ajustando nosso cockpit e uma das informações é a quantidade de clientes diferentes atendidos no período.
Vamos aos dados para ver se facilita a resposta:

Coluna A:A
CLIENTES
ALEX
CARLOS
ALEX
VAGNER
SERGIO
VAGNER

O resultado é 4, com os clientes ALEX, CARLOS, SERGIO E VAGNER.

Caso necessite de mais informações, é só falar!

Grande abraço a todos!

Atenciosamente,

Alex Lacerda
[email protected]

 
Postado : 11/04/2012 7:08 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Experimente:

=SOMA(1/CONT.SE(A6:A15;A6:A15)) (Finalize com CTRL+SHIFT+ENTER)

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/04/2012 8:03 am
chook
(@chook)
Posts: 197
Estimable Member
Topic starter
 

Reinaldo é em VBA, senão tenho que ter outra planilha de controle.

Atenciosamente,

Alex Lacerda
[email protected]

 
Postado : 11/04/2012 8:12 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Chook,
Pelo que entendi, vc precisa somente de uma celula com o total, não havendo necessidade de outra planilha.
Na falta de algo melhor; Vc pode obter o valor dinamicamente na planilha e limpa-la após salvar essa valor
Por exemplo obter o valor em z2, utilizando-se AB2 como auxiliar

Sub Exemplo()
Range("AB2").FormulaR1C1 = "=ADDRESS(2,1,1,1)&"":""&ADDRESS(COUNTA(C[-27])-1,1,1,1)"
Range("Z2").FormulaArray = "=SUM(1/COUNTIF(INDIRECT(RC[2]),INDIRECT(RC[2])))"
vl = Range("z2").Value
MsgBox vl

Range("Z2:AB2").ClearContents
MsgBox "o valor é: " & vl
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/04/2012 11:10 am
chook
(@chook)
Posts: 197
Estimable Member
Topic starter
 

Acho que assim não funciona, pois além da quantidade de clientes que compraram, temos ainda o vendedor e o período.

Atenciosamente,

Alex Lacerda
[email protected]

 
Postado : 11/04/2012 2:35 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite,

Veja se ajuda:

    Sub ContarExclusivos()
        Dim Colecao As New Collection
        Dim Qtde As Long
        Dim QtdeExcl As Long
       
        'Captura de erro
        On Error GoTo ERRO
       
        'Quantidade de itens a serem verificados
        Qtde = [A1].CurrentRegion.Rows.Count
       
        'Quantidade de itens exclusivos (diferentes)
        QtdeExcl = 0
       
        'Laço para percorrer todos os itens
        For i = 1 To Qtde
       
            'Caso não seja repetido adiciona o item a coleção
            Colecao.Add Cells(i, "A").Value, CStr(Cells(i, "A").Value)
           
            'Aumenta a quantidade de esclusivos
            QtdeExcl = QtdeExcl + 1
        Next
       
        'Apresenta mensagem com a quantidade de exclusivos
        MsgBox QtdeExcl
       
        'Sai da rotina
        Exit Sub
       
        'Rotina de erro
    ERRO:
       
        'Desconta os números repetidos
        QtdeExcl = QtdeExcl - 1
       
        'Retorna à próxima instrução após o erro
        Resume Next
    End Sub

Outra opção:

    Sub ContarExclusivos2()
        Dim Qtde As Long
       
        Qtde = [A1].CurrentRegion.Rows.Count
        [C1].FormulaLocal = "=SOMA(1/CONT.SE(A1:A" & Qtde & ";A1:A" & Qtde & "))"
        [C1].FormulaArray = [C1].Formula
        MsgBox [C1].Value
    End Sub

Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/04/2012 6:52 pm
chook
(@chook)
Posts: 197
Estimable Member
Topic starter
 

Grande JVal, sempre com soluções pros meus problemas mais estranhos...

Vamos ver se consigo me fazer entender:

O código está em pleno funcionamento com o código adaptado abaixo:

Sub ContarExclusivos()
Sheets("Pedidos").Select
    Dim Colecao As New Collection
    Dim Qtde As Long
    Dim QtdeExcl As Long
    On Error GoTo ERRO
    Qtde = [C1].CurrentRegion.Rows.Count
    QtdeExcl = 0
    For i = 2 To Qtde
    Colecao.Add Cells(i, "C").Value, CStr(Cells(i, "C").Value)
    QtdeExcl = QtdeExcl + 1
    Next
    QtdeExcl = QtdeExcl - 1
    MsgBox QtdeExcl
    Exit Sub
ERRO:
    QtdeExcl = QtdeExcl - 1
    Resume Next

End Sub

Agora o que preciso é que na parte do código abaixo adaptemos o sistema de contagem de clientes diferentes. No caso abaixo ele varre o banco acumulando a quantidade de pedidos e total de vendas do vendedor RODRIGO no mês de janeiro (1). Quero saber quantos clientes diferentes ele atendeu, por isso que quero o código comentado.

    If Range("AE" & j).Value = "RODRIGO" And Month(Range("B" & j).Value) = 1 Then
        vendas = vendas + Range("L" & j).Value
        qtd = qtd + 1
    End If

Segue abaixo código completo do pedaço destacado acima.

Sheets("Pedidos").Activate
Dim Linha, i, j, contador1, media1, vendas, qtd As Integer
Linha = Range("M20000").End(xlUp).Row

'***********4º Contador
contador1 = 0
media1 = 0
For i = 3 To Linha
    If Month(Range("B" & i).Value) = 1 Then
        contador1 = contador1 + Range("L" & i).Value
        media1 = media1 + 1
    End If
Next i
media.Caption = Format(contador1 / media1, "#,##0.00")

vendas = 0
qtd = 0
For j = 3 To Linha
  
    If Range("AE" & j).Value = "RODRIGO" And Month(Range("B" & j).Value) = 1 Then
        vendas = vendas + Range("L" & j).Value
        qtd = qtd + 1
    End If
    If Range("AE" & j).Value = "THYAGO" And Month(Range("B" & j).Value) = 1 Then
        vendas1 = vendas1 + Range("L" & j).Value
        qtd1 = qtd1 + 1
    End If
    If Range("AE" & j).Value = "HILDA" And Month(Range("B" & j).Value) = 1 Then
        vendas2 = vendas2 + Range("L" & j).Value
        qtd2 = qtd2 + 1
    End If
    If Month(Range("B" & j).Value) = 1 Then
        vendastot = vendastot + Range("L" & j).Value
    End If
        
   
Next j

Label16.Caption = Format(qtd, "0000")
Label17.Caption = Format(vendas, "#,##0.00")
Label18.Caption = Format(qtd1, "0000")
Label19.Caption = Format(vendas1, "#,##0.00")
Label24.Caption = Format(qtd2, "0000")
Label22.Caption = Format(vendas2, "#,##0.00")
Label27.Caption = Format(vendastot, "#,##0.00")
Label40.Caption = Format(vendas / metavenda.Caption, "0.00%")
Label39.Caption = Format(vendas2 / metavenda.Caption, "0.00%")
Label37.Caption = Format(vendas1 / metavenda.Caption, "0.00%")
End Sub

Grande abraço a todos!

Atenciosamente,

Alex Lacerda
[email protected]

 
Postado : 12/04/2012 1:44 pm
chook
(@chook)
Posts: 197
Estimable Member
Topic starter
 

Pessoal, como devo fazer para que seja colocado na coleção apenas pedidos do vendedor Rodrigo?

Range("AE" & j).Value = "RODRIGO"

E a mês seja maio:

Month(Range("B" & j).Value) = 5

O código abaixo já conta os exclusivos, o que preciso é que atenda aos filtros acima. HELP!

Sub ContarExclusivos()
Sheets("Pedidos").Select
        Dim Colecao As New Collection
        Dim Qtde As Long
        Dim QtdeExcl As Long
        On Error GoTo ERRO
        Qtde = [C3].CurrentRegion.Rows.Count
        QtdeExcl = 0
        For i = 2 To Qtde
            Colecao.Add Cells(i, "C").Value, CStr(Cells(i, "C").Value)
            QtdeExcl = QtdeExcl + 1
        Next
        QtdeExcl = QtdeExcl - 1
        MsgBox QtdeExcl
        Exit Sub
ERRO:
        QtdeExcl = QtdeExcl - 1
        Resume Next
End Sub

Atenciosamente,

Alex Lacerda
[email protected]

 
Postado : 18/04/2012 1:44 pm