Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Contse na listbox
 
Notifications
Clear all

Contse na listbox

 
2024 - VBA & Macros
Post Recente por robertonl 5 anos atrás
3 Posts
2 Usuários
0 Reactions
1,519 Visualizações
RSS
 robertonl
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

Boa tarde. Realizei varias tentativas e não estou conseguindo realizar o contse na listbox. a medida que os valores são acrescentados o valor da média altera. Alguém já enfrentou esta situação.
Arquivo em anexo para maiores esclarecimentos.
Segue código em anexo

Sub Dizimo_Semana()
Dim lItem, lItem1 As Double
Dim Total, Total1 As Double
Dim cont, contmaior, MyMediaMaior As Integer

Dim intIndex As Integer
Dim intCount As Integer


Total = 0
On Error GoTo trataerro
For lItem = 0 To Frm_PagamentoDizimo.Lst_CorpoPagamento.ListCount - 1
   If Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > 0.01 Then
    'If Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > media Then
        Total = Total + CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7))
        cont = cont + CDbl((Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > 0.01))
        media = CDbl((Total / cont))
        'contmaior = ((Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > media))
        'If Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > media Then
            'contmaior = Frm_PagamentoDizimo.Lst_CorpoPagamento.ListCount
            'contmaior = contmaior + CDbl((Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > media))
            'contmaior = contmaior + CDbl((contmaior > media))
        'End If
    End If
Next
media = CDbl((Total / cont))


With Sheets("Santa Rita")
        MyVar = WorksheetFunction.CountIf(.Range("q:q"), "ativo")
        Frm_PagamentoDizimo.BaseAtual = MyVar
        'MyAnalise = WorksheetFunction.CountIf(.Range("h:h"), "" > "" & Frm_PagamentoDizimo.MedDizSemana)n?o
        'myanalise = WorksheetFunction.CountIf(.Range("h:h"), "" < "" & Frm_PagamentoDizimo.MedDizSemana) n?o
        '"=COUNTIF(C[-4],<  Frm_PagamentoDizimo.MedDizSemana)"  - =CONT.SE(H2:H38;"<27,76")
       'Frm_PagamentoDizimo.Menor_MedMes = myanalise
        'Frm_PagamentoDizimo.ValReceb = Frm_PagamentoDizimo.MesAcumulado n?o
        'Frm_PagamentoDizimo.ValReceb = Format(Frm_PagamentoDizimo.ValReceb, "R$  0.00")n?o
     End With
Frm_PagamentoDizimo.ValReceb = Total
Frm_PagamentoDizimo.ValReceb = Format(Frm_PagamentoDizimo.ValReceb, "R$  0.00")
Frm_PagamentoDizimo.CalculoBase = (cont) * -1
Frm_PagamentoDizimo.MedDizSemana = (media) * -1
'Frm_PagamentoDizimo.MedDizSemana = Frm_PagamentoDizimo.ValReceb / Frm_PagamentoDizimo.CalculoBase
Frm_PagamentoDizimo.MedDizSemana = Format(Frm_PagamentoDizimo.MedDizSemana, "R$  0.00")
Frm_PagamentoDizimo.Calc_Percentual = Frm_PagamentoDizimo.CalculoBase / Frm_PagamentoDizimo.BaseAtual
Frm_PagamentoDizimo.Calc_Percentual = Format(Frm_PagamentoDizimo.Calc_Percentual, "0.00%")
'Frm_PagamentoDizimo.MaiorMedia = (contmaior) * -1
Frm_PagamentoDizimo.MaiorMedia = (cont) * -1
Frm_PagamentoDizimo.MaiorMedia = Frm_PagamentoDizimo.Lst_CorpoPagamento.ListCount > Frm_PagamentoDizimo.MedDizSemana
Frm_PagamentoDizimo.MaiorMedia = ((Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > media))
trataerro:
End Sub
 
Postado : 14/04/2020 2:59 pm
 Anderson
(@anderson)
Posts: 203
Reputable Member
 

Por que você nunca anexa o arquivo?

Em 90% dos casos em que não se anexa o arquivo, ocorrem mal-entendidos, gerando perda de tempo de ambos os lados.

 
Postado : 14/04/2020 4:07 pm
 robertonl
(@robertonl)
Posts: 121
Estimable Member
Topic starter
 

Utilizei este código abaixo, porém não funcionou.


Sub Somar_Dizimo()
Dim lItem As Double
Dim Total As Double
Dim cont As Integer

Dim intIndex As Integer
Dim intCount As Integer


Total = 0
On Error GoTo trataerro
For lItem = 0 To Frm_PagamentoDizimo.Lst_CorpoPagamento.ListCount - 1
If Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > 0.01 Then
        Total = Total + CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7))
        cont = cont + (CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7) > 0.01))
        media = CDbl((Total / cont))
'End If
'If CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7)) > 0.01 Then


'Total = Total + CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7))
'cont = cont + CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(lItem, 7))

End If
Next


With Sheets("Santa Rita")
        MyVar = WorksheetFunction.CountIf(.Range("q:q"), "ativo")
        Frm_PagamentoDizimo.BaseAtual = MyVar
        myanalise = WorksheetFunction.CountIf(.Range("h:h"), "" > "" & Frm_PagamentoDizimo.MedDizSemana)
        'myanalise = WorksheetFunction.CountIf(.Range("h:h"), "" < "" & Frm_PagamentoDizimo.MedDizSemana)
        '"=COUNTIF(C[-4],<  Frm_PagamentoDizimo.MedDizSemana)"  - =CONT.SE(H2:H38;"<27,76")
        'Frm_PagamentoDizimo.MenorMedia = myanalise
        'Frm_PagamentoDizimo.ValReceb = Frm_PagamentoDizimo.MesAcumulado
        'Frm_PagamentoDizimo.ValReceb = Format(Frm_PagamentoDizimo.ValReceb, "R$  0.00")
     End With
Frm_PagamentoDizimo.ValReceb = Total
Frm_PagamentoDizimo.CalculoBase = CDbl(cont * -1)
Frm_PagamentoDizimo.ValReceb = Format(Frm_PagamentoDizimo.ValReceb, "R$  0.00")
'Frm_PagamentoDizimo.MedDizSemana = Frm_PagamentoDizimo.ValReceb / Frm_PagamentoDizimo.CalculoBase
Frm_PagamentoDizimo.MedDizSemana = (media) * -1
Frm_PagamentoDizimo.MenorMedia = CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(7) < Frm_PagamentoDizimo.MedDizSemana)
Frm_PagamentoDizimo.IgualMedia = CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(7) = Frm_PagamentoDizimo.MedDizSemana)
Frm_PagamentoDizimo.MaiorMedia = CDbl(Frm_PagamentoDizimo.Lst_CorpoPagamento.List(7) > Frm_PagamentoDizimo.MedDizSemana)
Frm_PagamentoDizimo.MedDizSemana = Format(Frm_PagamentoDizimo.MedDizSemana, "R$  0.00")
Frm_PagamentoDizimo.Calc_Percentual = Frm_PagamentoDizimo.CalculoBase / Frm_PagamentoDizimo.BaseAtual
Frm_PagamentoDizimo.Calc_Percentual = Format(Frm_PagamentoDizimo.Calc_Percentual, "0.00%")
trataerro:
End Sub
 
Postado : 14/04/2020 7:44 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico