Home Excel - Dicas Microsoft Excel VBA Excel VBA - Jogos Excel planilha vba jogos mega sena computador faz dez jogos aleatorios com interacoes

Excel planilha vba jogos mega sena computador faz dez jogos aleatorios com interacoes

E-mail Imprimir PDF

Saberexcel - o site das macros

Essas Macros e Funções do Aplicativo Microsoft Excel VBA, produz uma dezena de jogos aleatórios da Mega-sena, usando interações aleatória no
em uma determinada célula. Abaixo as Funções Extenso usada neste exemplo foram inseridas com intuíto didático que poderá ajudar muitos em outras aplicações no Excel VBA.
Baixe o exemplo de planilha no fim da página.

Sub Teste()
'Range("D24").FormulaR1C1 = _
"=""Eu, seu computador farei, ""&Extenso(R[-23]C[5]) & "" Interações Aleatórias para 10 jogos."""
'Range("D25").Select
InsereNumerosAleatoriosSemDuplicados 60, Range("B1")
'Range("D24").FormulaR1C1 = _
' "=""Eu, seu computador fiz, ""&Extenso(R[-23]C[5]) & "" Interações Aleatórias para 10 jogos."""
'Range("D25").Select
End Sub

Sub InsereNumerosAleatoriosSemDuplicados(nValores As Integer, Cell As Range)
Dim Tabela As String, i As Integer, j As Integer
Tabela = ";"
Do While i < nValores
j = Int((nValores * Rnd) + 1)
If Not Tabela Like "*;" & j & ";*" Then
i = i + 1
Cell.Offset(i - 1, 0) = j
Tabela = Tabela & j & ";"
End If
Loop
End Sub

Sub jogar()
For i = 1 To Range("I1").Value
Teste
Next
End Sub

Sub Numeros_aleatorios_sem_duplicados()
Dim Tabel As New Collection
Dim i As Byte
Dim Valeur As Byte

On Error GoTo sbError

Do While i < 25
Valeur = Int(25 * Rnd) + 1
Tabel.Add Valeur, CStr(Valeur)
i = i + 1
Loop
For i = 1 To 25
Cells(i, 1) = Tabel(i)
Next i
Exit Sub

sbError:
i = i - 1
Resume Next

End Sub


'----------- F U N Ç Ã O E X T E N S O ----------------'
Function Extenso
( _
Valor As Currency, _
Optional MoedaNoSingular As String = "", _
Optional MoedaNoPlural As String = "", _
Optional CentavosNoSingular As String = "", _
Optional CentavosNoPlural As String = "") _
As String
Dim ParteInteira As Currency, ParteDecimal As Long
Dim s As String

ParteInteira = Fix(Valor)
ParteDecimal = Fix((Valor - ParteInteira) * 100)

s = ""
If ParteInteira > 0 Then
s = ConcatCentenas(ParteInteira)
If s = "um" Then 'ParteInteira = 1 ou 1.0 ou 1# não funciona
s = s & " " & MoedaNoSingular
Else
s = s & " " & MoedaNoPlural
End If
If ParteDecimal > 0 Then
s = s & " e "
End If
End If

If ParteDecimal > 0 Then
If ParteDecimal = 1 Then
s = s & "um " & CentavosNoSingular
Else
s = s & Centena(ParteDecimal) & " " & CentavosNoPlural
End If
End If
Extenso = s
End Function

Function Resto(A As Currency, B As Long) As Currency
Dim Aux As String, r As Currency
Aux = Format(A / B, "###0.0000")
Aux = Right$(Aux, 4)
Resto = Aux * B / 10000
If Resto < 1 And Resto > 0.99 Then
Resto = 1
End If
Aux = Format(Resto, "###0.0000")
Aux = Right$(Aux, 4)
Resto = Resto - Aux / 10000
End Function

Function DivInt(A As Currency, B As Long) As Currency
Dim Aux As String
DivInt = A / B
Aux = Format(DivInt, "###0.0000")
Aux = Right$(Aux, 4)
DivInt = DivInt - Aux / 10000
End Function

Private Function Unidade(N As Long) As String
Select Case N
Case 0
Unidade = ""
Case 1
Unidade = "um"
Case 2
Unidade = "dois"
Case 3
Unidade = "três"
Case 4
Unidade = "quatro"
Case 5
Unidade = "cinco"
Case 6
Unidade = "seis"
Case 7
Unidade = "sete"
Case 8
Unidade = "oito"
Case 9
Unidade = "nove"
Case Else
Err.Raise vbObjectError + 513, , "O número deve estar entre 0 e 9"
End Select
End Function

Private Function Dezena(N As Long) As String
Dim d As Long, u As Long
Dim s As String

d = N \ 10
u = N Mod 10

Select Case d
Case 0
Dezena = Unidade(N)
Exit Function
Case 1
Select Case u
Case 0
Dezena = "dez"
Case 1
Dezena = "onze"
Case 2
Dezena = "doze"
Case 3
Dezena = "treze"
Case 4
Dezena = "quatorze"
Case 5
Dezena = "quinze"
Case 6
Dezena = "dezesseis"
Case 7
Dezena = "dezessete"
Case 8
Dezena = "dezoito"
Case 9
Dezena = "dezenove"
End Select
Exit Function
Case 2
s = "vinte"
Case 3
s = "trinta"
Case 4
s = "quarenta"
Case 5
s = "cinqüenta"
Case 6
s = "sessenta"
Case 7
s = "setenta"
Case 8
s = "oitenta"
Case 9
s = "noventa"
Case Else
Err.Raise vbObjectError + 513, , "O número deve estar entre 0 e 99"
End Select

If u = 0 Then
Dezena = s
Else
Dezena = s & " e " & Unidade(u)
End If
End Function

Private Function Centena(N As Long) As String
Dim c As Long, d As Long
Dim s As String
c = N \ 100
d = N Mod 100

Select Case c
Case 0
Centena = Dezena(N)
Exit Function
Case 1
If d = 0 Then
Centena = "cem"
Else
Centena = "cento e " & Dezena(d)
End If
Exit Function
Case 2
s = "duzentos"
Case 3
s = "trezentos"
Case 4
s = "quatrocentos"
Case 5
s = "quinhentos"
Case 6
s = "seiscentos"
Case 7
s = "setecentos"
Case 8
s = "oitocentos"
Case 9
s = "novecentos"
Case Else
Err.Raise vbObjectError + 513, , "O número deve estar entre 0 e 999"
End Select

If d = 0 Then
Centena = s
Else
Centena = s & " e " & Dezena(d)
End If
End Function

Private Function SingleAlg(N As Currency) As Boolean
Dim s As String, i As Integer
s = N
SingleAlg = False
For i = 1 To Len(s)
If Mid$(s, i, 1) <> 0 Then
If SingleAlg Then
SingleAlg = False
Exit Function
Else
SingleAlg = True
End If
End If
Next i
End Function

Private Function ConcatCentenas(N As Currency) As String
Dim Trilhao As Long, Bilhao As Long, _
Milhao As Long, Milhar As Long, Um As Long, _
Menores As Integer
Dim s As String, m As Currency

s = ""
m = N

Um = Resto(N, 1000) 'Um = N Mod 1000
N = DivInt(N, 1000) 'N = N \ 1000
Milhar = Resto(N, 1000) 'Milhar = N Mod 1000
N = DivInt(N, 1000) 'N = N \ 1000
Milhao = Resto(N, 1000) 'Milhao = N Mod 1000
N = DivInt(N, 1000) 'N = N \ 1000
Bilhao = Resto(N, 1000) 'Bilhao = N Mod 1000
N = DivInt(N, 1000) 'N = N \ 1000
Trilhao = Resto(N, 1000) 'Trilhao = N Mod 1000000000

m = m - Trilhao * 1000000000000@
Menores = Bilhao + Milhao + Milhar + Um
If Trilhao > 0 Then
If Trilhao = 1 Then
s = "um trilhão"
Else
s = Centena(Trilhao) & " trilhões"
End If
If Menores > 0 Then
If SingleAlg(m) Then
s = s & " e "
Else
s = s & ", "
End If
Else
s = s & " de"
End If
End If

m = m - Bilhao * 1000000000@
Menores = Milhao + Milhar + Um
If Bilhao > 0 Then
If Bilhao = 1 Then
s = s & "um bilhão"
Else
s = s & Centena(Bilhao) & " bilhões"
End If
If Menores > 0 Then
If SingleAlg(m) Then
s = s & " e "
Else
s = s & ", "
End If
Else
s = s & " de"
End If
End If

m = m - Milhao * 1000000
Menores = Milhar + Um
If Milhao > 0 Then
If Milhao = 1 Then
s = s & "um milhão"
Else
s = s & Centena(Milhao) & " milhões"
End If
If Menores > 0 Then
If SingleAlg(m) Then
s = s & " e "
Else
s = s & ", "
End If
Else
s = s & " de"
End If
End If

m = -(Milhar * 1000) + m
Menores = Um
If Milhar > 0 Then
s = s & Centena(Milhar) & " mil"
If Menores > 0 Then
If SingleAlg(m) Then
s = s & " e "
Else
s = s & ", "
End If
End If
End If

s = s & Centena(Um)
ConcatCentenas = s
End Function



Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel





   Baixe o exemplo de planilha com as macros, funções e fórmulas acima.
Excel planilha vba jogos mega sena computador faz dez jogos aleatorios com interacoes (33.2 kB)



Publicidade:
Compre com garantia, segurança e ótimos preços nas lojas SubMarino.
Informática - Submarino.com.br

Última atualização em Sáb, 13 de Agosto de 2011 19:16  

Adicionar comentário

"Jamais considere seus estudos como uma obrigação, mas como uma oportunidade invejável para aprender a conhecer a influência libertadora da beleza do reino do espírito, para seu próprio prazer pessoal e para proveito da comunidade." Albert Einstein


Código de segurança
Atualizar

Pesquisa Google SaberExcel

Publicidade Google

Publicidade

Rastreamento Correios

Digite o número do SEDEX conforme o exemplo:
Correios do Brasil

Assinatura SaberExcel

Google Associados

Depoimentos

Visitantes SaberExcel

Excel VBA Estudos®
mod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_countermod_vvisit_counter
mod_vvisit_counterHoje190
mod_vvisit_counterOntem5059
mod_vvisit_counterEsta Semana19696
mod_vvisit_counterSemana passada36487
mod_vvisit_counterEsse mês33425
mod_vvisit_counterMês passado153723
mod_vvisit_counterTodos10456254
Aprenda MS Excel VBA

Adicione Saberexcel Favoritos

 
 

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


   Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA