Notifications
Clear all

tem como fazer VBA formula MÁXIMOSES e MÍNIMOSES

24 Posts
2 Usuários
0 Reactions
6,105 Visualizações
(@walteilson)
Posts: 8
Active Member
Topic starter
 

TEM COMO FAZER UMA FORMULA EM "VBA"?
bom pessoal sou novo,no foro e deixo aqui um tema se alguem tiver uma posição do assunto
gostaria de ter uma formula no excel de MÁXIMOSES e MÍNIMOSES como as ja existente no banco de dados
do excel (" somases,cont.ses,médiases").
consigo fazer usando formulas existente e transformado ela e matriz( juntando "máximo" e a de lógica "se" ) so
que fica muito pesada no caso de ter muitas desta dentro da mesma planilha que no meu caso uso, ai fica lento para o proseçador ou ate
mesmo trava.
deixo aqui anexo uma planilha com dados de exemplo.

 
Postado : 18/03/2012 3:29 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

White, como ele clicou na mãozinha da 1º postagem, indica que serviu.

Como eu havia em meu poste anterior, "assim que poder marcar resolvido", que ele fique a vontade para discutir a dúvida, caso ainda persista.

A questão é : Resolver um problema (independente da solução), ou escolher a prória maneira, mesmo que a mais tempestuosa.

Walteison, se pretende discutir o assunto, com as soluções via VBA, sinta se vontade!!!

Att..

 
Postado : 18/03/2012 8:13 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

walteilson fiz o q vc queria com Fórmula matricial e o arquivo não ficou pesado não. nem grande (apenas 12k)
Não sei se esse é o arquivo original... porém fica uma dica: se achar q ficou legal meu exemplo vc pode trocar os cálculos para manuais: assim vc só faria os cálculos ao apertar F9, não pesando o funcionamento do arquivo.

Qualquer duvida tamu ai

Dê retorno por favor

 
Postado : 18/03/2012 9:16 pm
(@walteilson)
Posts: 8
Active Member
Topic starter
 

alexandrevba
bom dia esta tambem consegui fazer rodar
=SOMARPRODUTO(MÁXIMO((A2:A7=A9)*(B2:B7)))
so que eu enverti pra eu localizar o mínino e nao consegue da sempres 0
sera posivel usar esta expressão pra adiquirir o minino ( que no ofice 2010 so aparece "min")
=SOMARPRODUTO(MIN((A2:A7=A9)*(B2:B7)))

SOBRES AS MACROS FUNÇÃO UMA CONSEGUI FAZER RODA SO QUE ELAS SO TRABLHA COM NUMERO INTEIRO E ALEN DOS NUMEROS INTEIRO
TENHO UMA QUE BUSCA VALOR + A MATRIZ CRITERIO E O CRITERIO E DATA AI ELA MOSTRA COMO ZERO FORMATANDO AS CELULAS PRA GERAL AI FUNCIONA SO SERIA MUITO BOM TIVER COMO AGENTE FIZESSE QUE FUNCIONASSE COM AFORMATAÇÃO

ESTA E MACRO

Option Explicit 

'These functions have been developed by Alan Forster on 27th September 2004.
'After years of desire he has actually written them!
'The functions use the same evaluation methods as the CountIf and SumIf functions

Public Function MinIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue > rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MinIf = varValue 
End Function 

Public Function MaxIf(rngEvaluate As Range, _ 
    strCondition As String, _ 
    Optional rngValues As Range = Nothing) As Variant 
    Dim varValue            As Variant 
    Dim bolValueSet         As Boolean 
    Dim intRow              As Integer, _ 
    intCol              As Integer 
     
    If (rngValues Is Nothing) Then Set rngValues = rngEvaluate 
    bolValueSet = False 
    If Not RangesOK(rngEvaluate, rngValues) Then 
         'Return an error value
        varValue = "Error in range selection" 
    Else 
         'If the ranges are not identically sized can not get this far!
        For intRow = 1 To rngEvaluate.Rows.Count 
            For intCol = 1 To rngEvaluate.Columns.Count 
                If Application.CountIf(rngEvaluate(intRow, intCol), strCondition) = 1 Then 
                    If bolValueSet Then 
                        If varValue < rngValues(intRow, intCol) Then varValue = rngValues(intRow, intCol) 
                    Else 
                        bolValueSet = True 
                        varValue = rngValues(intRow, intCol) 
                    End If 
                End If 
            Next intCol 
        Next intRow 
    End If 
    MaxIf = varValue 
End Function 

Private Function RangesOK(rng1 As Range, rng2 As Range) As Boolean 
    Dim bolAreas    As Boolean, _ 
    bolSize     As Boolean 
    bolAreas = (rng1.Areas.Count = 1) Or (rng2.Areas.Count = 1) 
    bolSize = (rng1.Rows.Count = rng2.Rows.Count) And _ 
    (rng1.Columns.Count = rng2.Columns.Count) 
    RangesOK = bolAreas And bolSize 
End Function 

+ DESDE JA AGRADEÇO A COLOBORAÇÃO DE TODOS

 
Postado : 19/03/2012 4:17 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Não use letras maiúscula!!!, não é legal!!

Em casa eu uso Office 2007, mas se não me engano é : =mínimoa( ), o excel 2010, em alguns casos tem algumas funções que tem marcar para usa-la. vem com um x, como estivesse desabilitada mas, apesar de s outras funções novas as substituírem.
Sua versão toda em português???

Olhe direto as postagem por mim e pelo White, pois creio ter coisa lá que resolve!!

Att

 
Postado : 19/03/2012 6:38 am
(@walteilson)
Posts: 8
Active Member
Topic starter
 

SIM, E OFFICE 2010 PROFISSIONAL PLUS
TEM AS FUNÇÃO
MÁXIMO
MAXIMOA

MIN
MINIMOA

ACHO QUE ERROR DO OFFICE POIS TEM E DUAS MAQUINA E INTALAÇÃO DIFERENTE E TEM O MESMO ERRO.
ACHO QUE INCLUSIVE VARIOS ERRO OUTRO EXEMPLO ATALHO PRA OCULTAR COLUNA TEM Ctrl+0 PRA REEXIBIR JA NÃO TEM QUE SERIA
Ctrl+SHIFT+0 ,NESTA VERÇÃO

 
Postado : 19/03/2012 2:17 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Olá, tente ver o lance de seu Office e por favor não poste com letras maiúsculas!!!

Concentre se nas postagem anteriores!!

Att

 
Postado : 19/03/2012 2:22 pm
(@walteilson)
Posts: 8
Active Member
Topic starter
 

ok , so pra ficar consoliado,
"todas os código sitado forma feitos so pra um critério ou seja máximose ou mínimose"

sera que e posivel esticar com mais critério tornado máximoses ou mínimoses , acho que nao prescisaria com tanto criterio conseguindo incluir
4 ja seria o bastante, buscar o máximoses de uma compra exemplo (1º data, usaria um intervalo e critério; 2º mercado, usaria um intervalo e critério
3º comprador, usaria um intervalo e critério ;4º entrega, usaria um intervalo e critério)

 
Postado : 19/03/2012 4:42 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Até que alguém responda de forma exata, poste (como sou eu quem está pedindo, não quero sobre carregar o fórum), em um site gratuito sendspce ou 4shred, seu modelo!

Obs: Você tem o Office 2010, não entendo, por ventura elas não tem no 2010??

Att

 
Postado : 19/03/2012 4:50 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Segue uma versão que aceita 2 condições:

Function maximose(intval1 As Range, intval2 As Range, intval3 As Range, cond As String, cond2 As String)
Application.Volatile
Dim wf As WorksheetFunction
Set wf = WorksheetFunction

Dim Matrix() As Variant
On Error GoTo fim
ReDim Matrix(intval1.Count, 1)
    For num = 1 To intval1.Count
        If intval2(num) = cond And intval3(num) = cond2 Then
        Matrix(num, 1) = intval1(num) * 1
        Else
        Matrix(num, 1) = 0
        End If
    Next
maximose = wf.Max(Matrix)

fim:
Debug.Print Err.Number & " " & Err.Description
End Function
 
Postado : 19/03/2012 7:29 pm
Página 2 / 2