Excel VBA - Jogos

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Descendente ]

    vba jogos bingo criar cartelas numeros aleatorios vba jogos bingo criar cartelas numeros aleatorios

    popular!
    Adicionado em: 25/11/2010
    Modificado em: 25/11/2010
    Tamanho: Vazio
    Downloads: 29905

    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)


    vba jogos confere mega sena vba jogos confere mega sena

    popular!
    Adicionado em: 25/11/2010
    Modificado em: 25/11/2010
    Tamanho: Vazio
    Downloads: 19694

    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



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

    popular!
    Adicionado em: 25/11/2010
    Modificado em: 25/11/2010
    Tamanho: Vazio
    Downloads: 2116

    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.
    Informática - Submarino.com.br

    vba jogos mega sena faz seis jogos aleatorios confere palpite vba jogos mega sena faz seis jogos aleatorios confere palpite

    popular!
    Adicionado em: 25/11/2010
    Modificado em: 25/11/2010
    Tamanho: Vazio
    Downloads: 31330

    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
    Informática - Submarino.com.br

    PROMOÇÃO DIDÁTICOS SABEREXCEL



    Adquira já o Acesso Imediato
    à Area de Membros

    Compra Grantida --- Entrega Imediata

    Aprenda Excel VBA com Simplicidade de 
    códigos e Eficácia, Escrevendo Menos e
    Fazendo Mais.

    '-------------------------------------'
    Entrega Imediata:
    +  500 Video Aulas MS Excel VBA
    +  35.000 Planilhas Excel e VBA
    +  Coleção 25.000 Macros MS Excel VBA
    +  141 Planilhas Instruções Loops
    +  341 Planilhas WorksheetFunctions(VBA)
    +    04 Módulos Como Fazer Excel VBA
    +  Curso Completo MS Excel VBA
    +  Planilhas Inteligentes


    Pesquisa Google SaberExcel

    Publicidade Google

    <script type="text/javascript"><!--

    google_ad_client = "ca-pub-2317234650173689";

    /* retangulo 336 x 280 */

    google_ad_slot = "0315083363";

    google_ad_width = 336;

    google_ad_height = 280;

    //-->

    </script>

    <script type="text/javascript"

    src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

    </script>

    Publicidade

    RSFirewallProtected


    Google Associados

    Depoimentos

    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