Funções e macros de uso geral :

Planilhas, Arquivos, modelos, exemplos, apostilas, nosso datacenter!

Funções e macros de uso geral :

Mensagempor Edcronos » Sáb Dez 20, 2014 10:36 am

.
Como o outro tópico ficou poluído pela perda dos arquivos resolvi fazer este.

=ULinhaRange("p";"Aj")
vai informar a ultima linha com dados da coluna "P" até "AJ" da aba ativa

=ULinhaRange("p";"Aj";"Plan2")
vai informar a ultima linha com dados da coluna "P" até "AJ" da "Plan2"

Código: Selecionar todos
Public Function ULinhaRange(ByVal Letra_Coluna_ini As String, ByVal Letra_Coluna_Fim As String, Optional Nome_aba As String) As Long   'ultima linha com dados
    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    cir = Cells(1, Letra_Coluna_ini).Column: cfr = Cells(1, Letra_Coluna_Fim).Column
    flc = 1
    For C = cir To cfr
    fl1 = Sheets(Nome_aba).Cells(Rows.Count, C).End(xlUp).Row
    If fl1 > flc Then flc = fl1
    Next
    ULinhaRange = flc
End Function
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

For this post the author Edcronos thanked:
Pepe (Dom Mai 27, 2018 2:01 am)
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

{ SO_SELECT }

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Sáb Dez 20, 2014 3:29 pm

para um uso mais limpo sem o uso de tantas variaveis
" a performance é a mesma"

Indicado polo : Reinaldo

Application.Volatile '<<<para não pesar na planilha, tirar essa linha se não precisar de uma verificação instantânea

Código: Selecionar todos
    Public Function ULinhaRange(ByVal Letra_Coluna_ini As String, _
                                ByVal Letra_Coluna_Fim As String, _
                                Optional Nome_aba As String) As Long   'ultima linha com dados

    Application.Volatile

    Dim C As Long, fLC As Long
    If Nome_aba = "" Then Nome_aba = ActiveSheet.Name
    fLC = 1
        For C = Cells(1, Letra_Coluna_ini).Column To Cells(1, Letra_Coluna_Fim).Column
            If Sheets(Nome_aba).Cells(Rows.Count, C).End(xlUp).Row > fLC Then _
            fLC = Sheets(Nome_aba).Cells(Rows.Count, C).End(xlUp).Row
        Next
    ULinhaRange = fLC
    End Function
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Qua Mai 13, 2015 9:32 pm

vou postar funções para estatísticas de loterias

uma é para contar quantas vezes deu um grupo de numeros procurados
coloquei para a mega, mas com pouca alteração funciona para qualquer loteria até para lotomania

=Cont_grupo(1;2;3;...)

=Cont_grupo(10;33)
total= 28 ultimo= 1699
no caso 10 e 33 deram 28 vezes juntos e a ultima vez foi no 1699

=Cont_grupo(10;33;11)
total= 1 ultimo= 1451

Código: Selecionar todos
Function Cont_grupo(ParamArray Grupos_juntos() As Variant)
    Dim TG1 As Long, TtL As Long, Coluno(), L1 As Long, C1 As Long

    With ThisWorkbook.Worksheets("Mega-Sena")
        lf1 = .Cells(Rows.Count, 1).End(xlUp).Row
        Coluno = .Range("A2:H" & lf1).Value2
    End With

    Cc1 = UBound(Coluno, 2)
    Lc1 = UBound(Coluno, 1)
    CC2 = UBound(Grupos_juntos, 1)

    For L1 = Lc1 To 1 Step -1
        TtL = 0
        For C1 = 3 To Cc1
            For c2 = 0 To CC2
                If Coluno(L1, C1) = Grupos_juntos(c2) Then
                    TtL = TtL + 1:
                    If TtL = CC2 + 1 Then
                        TG1 = TG1 + 1:
                        If TG1 = 1 Then concs = Coluno(L1, 1)
                        GoTo lk0
                    End If
                End If
            Next
        Next
lk0:
    Next
    Cont_grupo = " total= " & TG1 & "  ultimo= " & concs
End Function


depois eu posto o de fechamento
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Qua Mai 13, 2015 10:00 pm

essa retorna o fechamento de um ciclo

CicloTo(1)
vai retornar em qual cocurso teve o fechamento a partir do 1
fechamento é quando saiu todas as dezenas


Código: Selecionar todos
Function CicloTo(concursoNum As Long)

    Dim valt(1 To 60) As Long, linSort()
    With ThisWorkbook.Worksheets("Mega-Sena")

        lf = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        L = concursoNum + 1
ijSini:

        linSort = .Range("C" & L, "H" & L).Value2
        For v = 1 To 6
            valt(linSort(1, v)) = 1
        Next
        If L < lf Then
            For v = 1 To 60
                If valt(v) = 0 Then L = L + 1: GoTo ijSini:
            Next
        End If
    End With
    CicloTo = L - 1

End Function


nessa e na outra eu coloquei coisas mais avançadas
tipo qual dezena mais saiu junto do grupo procurado
ou no ciclo quantas vezes saiu cada dezena no ciclo pesquisado
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Sáb Mai 30, 2015 9:55 pm

Função máximo (VBA)

na planilha vale nada, é apenas para testar
mas em busca de array ...

Código: Selecionar todos
    Public Function MaxY(ByRef nomeArrayt As Range, Optional Valor_max_de_Referencia As Long) As Long
        Dim nomeArray()
        Dim maxi As Long, mv As Long
        nomeArray = nomeArrayt.Value2
        For L = 1 To UBound(nomeArray, 1)
            For c = 1 To UBound(nomeArray, 2)
                mv = nomeArray(L, c)
                If Valor_max_de_Referencia = 0 Or mv < Valor_max_de_Referencia Then
                    If maxi < mv Then maxi = mv
                End If
            Next
        Next
        MaxY = maxi
    End Function




para usar com array por referencia :
Código: Selecionar todos
    Public Function MaxY(ByRef nomeArray as variant, Optional Valor_max_de_Referencia As Long) As Long

        Dim maxi As Long, mv As Long

        For L = 1 To UBound(nomeArray, 1)
            For c = 1 To UBound(nomeArray, 2)
                mv = nomeArray(L, c)
                If Valor_max_de_Referencia = 0 Or mv < Valor_max_de_Referencia Then
                    If maxi < mv Then maxi = mv
                End If
            Next
        Next
        MaxY = maxi
    End Function

Valor_max_de_Referencia é um algo a mais
caso se queira o maior valor mas que seja abaixo de certo valor "usem a imaginação para descobrir para que serve"
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Qua Jun 10, 2015 5:25 am

SeparaPartX("55 - 44 - 29 - 74 - 52" ; " - "; 3) = 29
SeparaPartX("04:74:24:64:73:37:69" ; ":"; 2) = 74
SeparaPartX("nada|tudo|casa" ; "|"; 2) = tudo

valores numéricos são números mesmos e não texto
Código: Selecionar todos
Public Function SeparaPartX(ByVal Textoss As String, ByVal Separador As String, posição As Long)
    v = Split(Textoss, Separador)

    If posição <= UBound(v) + 1 Then
        If IsNumeric(v(posição - 1)) = True Then
            SeparaPartX = Val(v(posição - 1))
        Else
            SeparaPartX = v(posição - 1)
        End If
    Else
        SeparaPartX = ""
    End If
End Function
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor Edcronos » Qui Jun 18, 2015 12:12 am

para não se perder...
planilha de desdobramento com opção de valores fixos
Você não está autorizado a ver ou baixar esse anexo.
Somente é impossíveis até que alguém faça
A logica está presa na irracionalidade humana, e morta nos que se consideram donos da verdade.

"ALGUM MODERADOR ME EXPULSE DO FÓRUM POR FAVOR"

For this post the author Edcronos thanked:
Pepe (Dom Mai 27, 2018 2:03 am)
Edcronos
Membro
Membro
 
Mensagens: 1062
Registrado em: Ter Mar 18, 2014 3:40 pm
Has thanked: 87 times
Have thanks: 205 times

Re: Funções e macros de uso geral :

Mensagempor edcronos2 » Qua Dez 07, 2016 3:14 am

numeros que faltam na range

Código: Selecionar todos
    Function Ed_NunAusente(ByVal Rang As Range, ByVal Ocorrencia As Long, ByVal Menor_Valor As Long, ByVal Maior_Valor As Long) As Long
         reg1 = Rang.Value2
         Lc1 = UBound(reg1, 1): Cc1 = UBound(reg1, 2)
         ocr = 0
         For V = Menor_Valor To Maior_Valor
              TtL = 0:
              For L = 1 To Lc1
                   For c = 1 To Cc1
                        If reg1(L, c) = V Then TtL = 1: Exit For
                   Next:
              Next
              If TtL = 0 Then ocr = ocr + 1
              If ocr = Ocorrencia And TtL = 0 Then Ed_NunAusente= V: Exit Function
         Next
    End Function




menor e maior funciona como filtro,
se me animar monto sem isso e mais otimizado

range=
1 - 30 - 6
5 - 10 - 13
formula
=Ed_NunAusente( range; ocorrência; menor 1; maior 20)

ocorrência= 1 ; resultado= 2
ocorrência= 6 ; resultado= 9
ocorrência= 10 ; resultado= 15

maior 20
nesse caso nao identificaria números acima de 20
edcronos2
Membro
Membro
 
Mensagens: 464
Registrado em: Seg Nov 30, 2015 6:59 pm
Has thanked: 28 times
Have thanks: 102 times


Voltar para Biblioteca

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 1 visitante