Essa macro do Aplicativo Microsoft Excel VBA, cria cartelas de bingo com números aleatórios para jogos.
observem as macros usadas abaixo, importante verificar que o exemplo foi feito atraves de uma macro gravada.

Sub Inserir_Formulas()
' Atalho do teclado: Ctrl+F
Limpar
Centralizar
Range("A1:E20").Select
With Selection.Font
.Name = "Arial Narrow"
.Size = 26
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1:E20").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("F1").Select
Rows("1:20").RowHeight = 34.5
Range("A1") = "B"
Range("B1") = "I"
Range("C1") = "N"
Range("D1") = "G"
Range("E1") = "O"
Range("c4") = "LIVRE"

Range("A8") = "B"
Range("B8") = "I"
Range("C8") = "N"
Range("D8") = "G"
Range("E8") = "O"
Range("c11") = "LIVRE"

Range("A15") = "B"
Range("B15") = "I"
Range("C15") = "N"
Range("D15") = "G"
Range("E15") = "O"
Range("c18") = "LIVRE"
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-1),Saber2!R1C2:R15C2,0))"
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-1),Saber2!R1C5:R15C5,0))"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-1),Saber2!R1C8:R15C8,0))"
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-1),Saber2!R1C11:R15C11,0))"
Range("E2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-1),Saber2!R1C14:R15C14,0))"
Range("A3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-1),Saber2!R1C2:R15C2,0))"
Range("B3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-1),Saber2!R1C5:R15C5,0))"
Range("C3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-1),Saber2!R1C8:R15C8,0))"
Range("D3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-1),Saber2!R1C11:R15C11,0))"
Range("E3").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-1),Saber2!R1C14:R15C14,0))"
Range("A4").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-1),Saber2!R1C2:R15C2,0))"
Range("B4").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-1),Saber2!R1C5:R15C5,0))"
Range("D4").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-1),Saber2!R1C11:R15C11,0))"
Range("E4").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-1),Saber2!R1C14:R15C14,0))"
Range("A5").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-1),Saber2!R1C2:R15C2,0))"
Range("B5").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-1),Saber2!R1C5:R15C5,0))"
Range("C5").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-1),Saber2!R1C8:R15C8,0))"
Range("D5").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-1),Saber2!R1C11:R15C11,0))"
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-1),Saber2!R1C14:R15C14,0))"
Range("A6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-1),Saber2!R1C2:R15C2,0))"
Range("B6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-1),Saber2!R1C5:R15C5,0))"
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-1),Saber2!R1C8:R15C8,0))"
Range("D6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-1),Saber2!R1C11:R15C11,0))"
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-1),Saber2!R1C14:R15C14,0))"
Range("A9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-3),Saber2!R1C2:R15C2,0))"
Range("B9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-3),Saber2!R1C5:R15C5,0))"
Range("C9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-3),Saber2!R1C8:R15C8,0))"
Range("D9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-3),Saber2!R1C11:R15C11,0))"
Range("E9").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-3),Saber2!R1C14:R15C14,0))"
Range("A10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-3),Saber2!R1C2:R15C2,0))"
Range("B10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-3),Saber2!R1C5:R15C5,0))"
Range("C10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-3),Saber2!R1C8:R15C8,0))"
Range("D10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-3),Saber2!R1C11:R15C11,0))"
Range("E10").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-3),Saber2!R1C14:R15C14,0))"
Range("A11").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-3),Saber2!R1C2:R15C2,0))"
Range("B11").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-3),Saber2!R1C5:R15C5,0))"
Range("D11").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-3),Saber2!R1C11:R15C11,0))"
Range("E11").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-3),Saber2!R1C14:R15C14,0))"
Range("A12").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-3),Saber2!R1C2:R15C2,0))"
Range("B12").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-3),Saber2!R1C5:R15C5,0))"
Range("C12").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-3),Saber2!R1C8:R15C8,0))"
Range("D12").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-3),Saber2!R1C11:R15C11,0))"
Range("E12").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-3),Saber2!R1C14:R15C14,0))"
Range("A13").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-3),Saber2!R1C2:R15C2,0))"
Range("B13").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-3),Saber2!R1C5:R15C5,0))"
Range("C13").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-3),Saber2!R1C8:R15C8,0))"
Range("D13").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-3),Saber2!R1C11:R15C11,0))"
Range("E13").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-3),Saber2!R1C14:R15C14,0))"
Range("E14").Select
ActiveWindow.SmallScroll Down:=9
Range("A16").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-5),Saber2!R1C2:R15C2,0))"
Range("B16").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-5),Saber2!R1C5:R15C5,0))"
Range("C16").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-5),Saber2!R1C8:R15C8,0))"
Range("D16").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-5),Saber2!R1C11:R15C11,0))"
Range("E16").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-5),Saber2!R1C14:R15C14,0))"
Range("A17").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-5),Saber2!R1C2:R15C2,0))"
Range("B17").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-5),Saber2!R1C5:R15C5,0))"
Range("C17").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-5),Saber2!R1C8:R15C8,0))"
Range("D17").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-5),Saber2!R1C11:R15C11,0))"
Range("E17").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-5),Saber2!R1C14:R15C14,0))"
Range("A18").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-5),Saber2!R1C2:R15C2,0))"
Range("B18").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-5),Saber2!R1C5:R15C5,0))"
Range("D18").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-5),Saber2!R1C11:R15C11,0))"
Range("E18").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-5),Saber2!R1C14:R15C14,0))"
Range("A19").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-5),Saber2!R1C2:R15C2,0))"
Range("B19").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-5),Saber2!R1C5:R15C5,0))"
Range("C19").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-5),Saber2!R1C8:R15C8,0))"
Range("D19").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-5),Saber2!R1C11:R15C11,0))"
Range("E19").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-5),Saber2!R1C14:R15C14,0))"
Range("A20").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C1:R15C1,MATCH(LARGE(Saber2!R1C2:R15C2,ROW()-5),Saber2!R1C2:R15C2,0))"
Range("B20").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C4:R15C4,MATCH(LARGE(Saber2!R1C5:R15C5,ROW()-5),Saber2!R1C5:R15C5,0))"
Range("C20").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C7:R15C7,MATCH(LARGE(Saber2!R1C8:R15C8,ROW()-5),Saber2!R1C8:R15C8,0))"
Range("D20").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C10:R15C10,MATCH(LARGE(Saber2!R1C11:R15C11,ROW()-5),Saber2!R1C11:R15C11,0))"
Range("E20").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(Saber2!R1C13:R15C13,MATCH(LARGE(Saber2!R1C14:R15C14,ROW()-5),Saber2!R1C14:R15C14,0))"
Range("E21").Select
[G4] = "pressione a tecla {Delete} para mudar os números"
[G5] = "pressione a tecla {Control + F} para Iniciar"
Application.Goto Reference:=Worksheets("Saber1").Range("A1"), Scroll:=True
Range("F1").Select

End Sub

Sub Limpar()
Application.ScreenUpdating = False
Range("A1:E100").Select
'Selection.ClearFormats
Selection.RowHeight = 12
Selection.ClearContents
Range("F2").Select
Rows("1:20").RowHeight = 34.5
'Range("A1") = "B"
'Range("B1") = "I"
'Range("C1") = "N"
'Range("D1") = "G"
'Range("E1") = "O"
Range("G7").Select
Application.ScreenUpdating = True
End Sub

Sub Centralizar()
Range("A1:E22").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Selection.ColumnWidth = 12.35
Range("G3").Select
Range("g1").Select

End Sub

Sub Desbloquear_ignorar_erro()
Range("A2:E6").Select
Selection.Locked = False
Selection.FormulaHidden = True
Range("F1").Select
End Sub


Aprenda Microsoft Excel VBA (Saberexcel - o site das macros)

Saberexcel - o site das macros
Exemplo de planilha do Microsoft Excel VBA - SaberExcel VBA e fórmulas, contém fórmulas e macros que retorna o resultado de acertos nos jogos da Mega-Sena, são usadas algumas fórmulas, retorna se voce fez um Duque, Terno, Quadra, Quina, Sena!!!
veja abaixo, mas voce poderá baixar o exemplo para verificar melhor.

Somente duas fórmulas usadas.

=SE(I8=2;"Duque";SE(I8=3;"Terno";SE(I8=4;"Quadra !";SE(I8=5;"Quina !";SE(I8=6;"MEGASENA !!!";"-")))))
=CONT.SE(K7:P7;">0")

Sub Ordena()
Range("C7:J206").Select
Selection.Sort Key1:=Range("I7"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
[S1].Select
End Sub


Aprenda Microsoft Excel VBA - SaberExcel VBA- o site das macros

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 o Aplicativo Microsoft Excel VBA com SaberExcel

Baixe o exemplo de planilha com as macros, funções e fórmulas acima.




Publicidade:
Compre com garantia, segurança e ótimos preços nas lojas SubMarino.

Saberexcel o site das Macros
Essas macros do Aplicativo Microsoft Excel VBA, conferem jogos da mega-sena, com auxílio de algumas fórmulas, fazem 6 jogos aleatórios.

Sub NN()
Application.SendKeys ("{DEL}") 'quit
End Sub

Sub contador()
x
i = 0
For i = 1 To Range("J1").Value
NN
Next
End Sub

Sub xx()
Application.Calculation = xlCalculationManual
End Sub

Sub x()
'Insira aqui o seu código
Application.Calculation = xlCalculationAutomatic
End Sub

Sub x1x()
Range("J1").FormulaR1C1 = "=INT(RAND()*10)"
Sheets("Mega-sena").Shapes("Botao").TextFrame.Characters.Text = "Computador Jogue com !! - " & Range("J1") & " interações"
End Sub

Sub x1xx()
Range("J1").FormulaR1C1 = "=INT(RAND()*100)"
Sheets("Mega-sena").Shapes("Botao").TextFrame.Characters.Text = "Computador Jogue com !! - " & Range("J1") & " interações"
End Sub

Sub x1xxx()
Range("J1").FormulaR1C1 = "=INT(RAND()*1000)"
Sheets("Mega-sena").Shapes("Botao").TextFrame.Characters.Text = "Computador Jogue com !! - " & Range("J1") & " interações"
End Sub

Sub x1xxxx()
Range("J1").FormulaR1C1 = "=INT(RAND()*10000)"
Sheets("Mega-sena").Shapes("Botao").TextFrame.Characters.Text = "Computador Jogue com !! - " & Range("J1") & " interações"
End Sub

Sub Jogue()
contador
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA






Compre com segurança, garantia e ótimos preços