Jump to content

funções e macros VBA EXCEL


Guest Zangado

Recommended Posts

Guest Zangado

 

 

 

VARIAS FUNÇÕES VBA EXCEL

 

CSN

Function cobinaçãoCSN(combinação As Range, ByVal valor_max As Long)
     If IsArray(combinação) Then
          arr = combinação     '.Value2
          C = UBound(arr, 2)
          If UBound(arr, 1) > 1 Then cobinaçãoCSN = "apenas uma linha por combinação": Exit Function
          Dim i As Long
          Dim b As Double, dd As Double


          b = 1
          For i = 0 To C - 1
               b = b * (valor_max - i) / (C - i)
          Next
          dd = b
          c3 = C
          For cc = 1 To c3
               N = valor_max - arr(1, cc)
               b = 1
               For i = 0 To C - 1
                    b = b * (N - i) / (C - i)
               Next
               C = C - 1
               dd = dd - b
          Next
          cobinaçãoCSN = dd
     End If
End Function

 

CICLO

Function CicloQ1(concursoNum As Long)


     ReDim valt(dz1 To dz2) As Long
     Dim linSort(), L As Long, V As Long, lf As Long
     With ThisWorkbook.Worksheets("Base")     '>>>>>>nome da aba com sorteios
          dz1 = 1     '>>>>>>>>>>menor dezena
          dz2 = 3     '>>>>>>>>>>maior dezena
          ci = "m"     '>>>>>>>>>>coluna inicial
          cf = "o"     '>>>>>>>>>>>coluna final
		 LINHAINI = 9

          lf = .Cells(Rows.Count, 3).End(xlUp).Row + 1
          L = concursoNum + LINHAINI-1

ijSini:
          If L >= lf Then CicloQ1 = "null": Exit Function
          linSort = .Range(ci & L, cf & L).Value2

          For V = dz1 To dz2
               vv = linSort(1, V)
               If vv >= dz1 And vv <= dz2 Then valt(vv) = 1
          Next
          If L < lf Then
               For V = dz1 To dz2
                    If valt(V) = 0 Then L = L + 1: GoTo ijSini:
               Next
          End If
     End With

     CicloQ1 = L - 9

End Function

 

=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

 

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
    With ThisWorkbook.Worksheets("Mega-Sena") <<<ABA DO RESULTADO
        lf1 = .Cells(Rows.Count, 1).End(xlUp).Row
        Coluno = .Range("A2:H" & lf1).Value2 <<<
"A2:H"
A=COLUNA INICIAL DO RESULTADO, 
2= LINHA INICIAL DO RESULTADO,
H = COLUNA FINAL DO RESULTADO
    End With

 

OCORRÊNCIA DE NUMERO AUSENTE

     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

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...