Notifications
Clear all

Contar registro e caracteres digitados por data

16 Posts
3 Usuários
0 Reactions
2,184 Visualizações
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Boa-noite,

Gostaria de uma ajuda com uma macro que contasse os registros e os caracteres digitados na planilha por dia e gerasse um relatório em outra "Plan". Um módulo.

att,

Francisco

 
Postado : 15/04/2016 8:26 pm
edilsonfl
(@edilsonfl)
Posts: 227
Estimable Member
 

boa noite fcarlosc,

ficaria mais simples de entender se vc postasse uma planilha como exemplo do resultado esperado.

Mesmo assim, implementei um modelo simples, baseado na sua explicação.
Não usei VBA apenas as fórmulas do excel, combinada com função matricial.

Verifque se antede, dê retorno.

Quando ajuda for útil dê um clique na mãozinha, isso atribui ponto ao colaborador.

 
Postado : 15/04/2016 9:06 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Boa-noite,

Por fórmula funciona bem, mais o problema é que fica muito lento a planilha, se for em VBA, usaria como uma rotina, no final do dia ou no dia seguinte eu rodaria essa rotina, que faria essa contagem por data, colocaria o resultado em outra planilha.

Ex.: Eu digitei a semana inteira e na sexta-feira resolvi rodar a rotina;

Nº. Quest.: Nome: até a última coluna Data:

1 Francisco 11/04/2016
2 Edilson 11/04/2016
3 Francisco Carlos 12/04/2016
4 Edilson NFL 12/04/2016

A rotina pegaria por data e faria a contagem...criaria tipo um relatório em outra planilha.

Data: Qte Registro: Total de Caracteres Digitados:

11/04/2016 2 16
12/04/2016 2 27

e assim por diante...!

Obs: contando os espaços também

 
Postado : 15/04/2016 10:02 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O seu modelo não contem nenhum dado, e fiquei com duvida, então baseado no modelo do colega edilson utilize a rotina abaixo :

Sub CountaPalavras_Caracteres()
    Dim MyRange As Range
    Dim CellCount As Long
    Dim TotalPalavras As Long
    Dim NumPalavras As Integer
    Dim Raw As String
    Dim CaracteresCount As Long
    Dim N As Long
    
    Set MyRange = ActiveSheet.Range("A1:F14")
    
    TotalPalavras = 0
    
    For CellCount = 1 To MyRange.Cells.Count
        If Not MyRange.Cells(CellCount).HasFormula Then
            Raw = MyRange.Cells(CellCount).Value
            N = Len(Raw)
                
            Raw = Trim(Raw)
                
                If Len(Raw) > 0 Then
                    NumPalavras = 1
                Else
                    NumPalavras = 0
                End If
                
                    While InStr(Raw, " ") > 0
                        Raw = Mid(Raw, InStr(Raw, " "))
                        Raw = Trim(Raw)
                        NumPalavras = NumPalavras + 1
                    Wend
                
                TotalPalavras = TotalPalavras + NumPalavras
            
            End If
            
            CaracteresCount = CaracteresCount + N
            
        Next CellCount
        
        MsgBox "Total de Caracteres na planilha: " & Format(CaracteresCount, "#,##0")
        MsgBox "Total de " & TotalPalavras & " palavras Planilha."
        
End Sub

Veja se consegue adaptar ao que pretende.

[]s

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

 
Postado : 16/04/2016 9:11 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Boa-noite Mauro,
É quase isso, a contagem tá OK. Mais daria para fazer por data ? Eu criaria uma coluna data e quando salvar o registro com a data na última coluna "Data Corrente".

Ex.:(HOJE).

Assim seria feito toda essa contagem à partir da data. Meu cadastro começa com Nº do Questionário e termina no email, então a data seria depois do email. Vamos supor que eu digitei 100 registro no dia, então a rotina pegaria a data faria a contagem dos caracteres digitados e dos registro, salvando esses resultados em uma planilha.

att,

Francisco

 
Postado : 17/04/2016 8:52 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Francisco, como eu disse, seu modelo está em branco e nao tem a coluna data e agora diz que iria acrescentar tal coluna, mas a questão inicial está resolvida tanto por formula como VBA, e se quer utilizar o VBA é só ajustar a rotina, como não citou se a planilha em questão terá somente uma data ou várias fica dificil :
Vamos supor que eu digitei 100 registro no dia, então a rotina pegaria a data faria a contagem dos caracteres digitados e dos registro, salvando esses resultados em uma planilha.
Supondo que estes 100 registros são datas diferentes, e já que seu modelo está com o filtro habilitado, eu sugiro filtrar por data em uma nova aba e utilizar a rotina para rodar na aba filtrada, assim terá as contagens referentes a data filtrada.

[]s

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

 
Postado : 17/04/2016 10:20 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Bom-dia Mauro
Segue anexo a planilha com algumas informações, com a data e com a macro que você mandou. Está funcional, gostaria que a rotina contasse por data.
Coloquei 5 registros com a data 15/04/2016 e 5 com a data 18/04/2016. A macro teria que fazer a contagem do registro nº 1 ao registro nº 5 com a data "x" (15/04/2016) e registro nº 6 ao registro nº 10 com a data "x" (18/04/2016) e salvasse essas informações em outra planilha. Tipo um relatório.

att,

Francisco

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

Carlos, acredito que a melhor forma de se fazer é como citei anteriormente, utilizando o filtro, então veja se o modelo anexo é o que pretende.
Implementei um modelo antigo onde filtramos uma lista sem repetições para novas abas e apliquei a rotina de contar caracteres e palavras jogando o resultado na aba Relatorio.

Filtrar por Datas e contar palavras e caracteres

[]s

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

 
Postado : 18/04/2016 8:15 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

É isso mesmo Mauro....ficou bacana !
Mais eu queria que mudasse uma coisa...ao invés de contar palavras, ele contasse os registros (as linhas) conforme as datas.
Ex.: Data -- Caracteres -- Registros

Sei que estou abusando da boa vontade, ainda não tenho muito conhecimento da ferramenta.

Att,

Francisco

 
Postado : 18/04/2016 9:06 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

fcarlos

Você não esta agradecendo as respostas corretas que recebeu. por isso, leia o conteúdo do link abaixo:

viewtopic.php?f=7&t=16757

[]s

Patropi - Moderador

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

 
Postado : 19/04/2016 7:14 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Se entendi, troque a rotina "Sub CountaPalavras_Caracteres()" pela a abaixo :
As linhas que irão ficar em verde é porque estão desabilitadas, só para você ver onde foi alterado, depois de fazer os testes pode apaga-las.

Sub Conta_Caracteres_TT_Registros()
    Dim MyRange As Range
    Dim CellCount As Long
    Dim TotalPalavras As Long
    Dim NumPalavras As Integer
    Dim Raw As String
    Dim CaracteresCount As Long
    Dim N As Long
    Dim UltimaLinha As Long
    Dim UltimaLinhaR As Long
    Dim sTTRegistros As Long
    
    Set wsRelat = Worksheets("Relatorio")
    
    UltimaLinha = wsNew.Cells(Cells.Rows.Count, 1).End(xlUp).Row '+ 1
    
    sTTRegistros = wsNew.Cells(Cells.Rows.Count, 1).End(xlUp).Row - 1
    
    Set MyRange = wsNew.Range("A2:" & "L" & UltimaLinha)
    
    'TotalPalavras = 0
    
    For CellCount = 1 To MyRange.Cells.Count
        If Not MyRange.Cells(CellCount).HasFormula Then
            Raw = MyRange.Cells(CellCount).Value
            N = Len(Raw)
                
            'Raw = Trim(Raw)
                
            'If Len(Raw) > 0 Then
            '    NumPalavras = 1
            'Else
             '   NumPalavras = 0
            'End If
                
             '   While InStr(Raw, " ") > 0
             '       Raw = Mid(Raw, InStr(Raw, " "))
              '      Raw = Trim(Raw)
             '       NumPalavras = NumPalavras + 1
             '   Wend
                
           ' TotalPalavras = TotalPalavras + NumPalavras
            
        End If
            
        CaracteresCount = CaracteresCount + N
            
    Next CellCount
        
    UltimaLinhaR = wsRelat.Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1
    wsRelat.Range("A" & UltimaLinhaR) = c.Value
    wsRelat.Range("B" & UltimaLinhaR) = Format(CaracteresCount, "#,##0")
    wsRelat.Range("C" & UltimaLinhaR) = sTTRegistros
 
    Application.DisplayAlerts = False
    wsNew.Delete
  
End Sub

E na Rotina "Sub FiltraEmAbas()" troque a linha abaixo :
Esta :
"Call CountaPalavras_Caracteres"
Por esta :
Call Conta_Caracteres_TT_Registros

[]s

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

 
Postado : 19/04/2016 5:27 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Boa-noite Mauro
Inseri o código com as alterações e funcionou de boa. Mais quando eu jogo a rotina no arquivo "original" da erro.

att,

Francisco

 
Postado : 20/04/2016 3:31 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Você copiou e não alterou o nome da aba, em seu modelo anterior era "Dados Cadastrais" e neste é "Plan1"
Então se for manter "Plan1", altere o nome nas instruções abaixo:
'Aqui :
Set ws1 = Sheets("Dados Cadastrais")

E Aqui :
'Filtra para a nova aba
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Dados Cadastrais").Range("R1:R2"), _
CopyToRange:=wsNew.Range("A1"), Unique:=False

[]s

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

 
Postado : 21/04/2016 6:35 pm
fcarlosc
(@fcarlosc)
Posts: 453
Honorable Member
Topic starter
 

Bom-dia
Já tinha feito essa alterção, porém ele dá erro na linha onde fica "Ultimalinha".
No meu botão "Salvar" existe a variável "UltimaLinha", mais fica em outra local, será que está dando conflito !?

UltimaLinha = wsNew.Cells(Cells.Rows.Count, 1).End(xlUp).Row '+ 1

Vou alterar essa variável do meu botão e ver no que dá. Por hora agradeço.

Att,

Francisco

 
Postado : 22/04/2016 5:55 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Carlos, consegui baixar este último modelo que anexou, fiz as alterações do nome da aba como indiquei, executei o formulário varias vezes e clicando no botão SALVAR correu tudo certo, sem erros.
Normalmente em programação devemos evitar ter Variáveis com o mesmo nome para evitar conflitos, mas como executou normalmente, acredito que não seja este o motivo, se o erro está ocorrendo em outro arquivo que não este que anexou, verifique as rotinas e os passos que estão sendo executadas.

[]s

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

 
Postado : 22/04/2016 6:39 am
Página 1 / 2