Guest Zangado Posted December 4, 2018 Share Posted December 4, 2018 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.