Funcao Date Retorna Semana Apartir da Data Atual

Sub teste3()
Dim data As Date
data = Date
MsgBox DateAdd("ww", 9, data)
'Retorna semana apartir da data Atual
End Sub

Funcao Date Data Ate 9 mese

Sub teste2()
Dim data As Date
data = Date
MsgBox DateAdd("q", 3, data)
'Retorna daqui 9 meses
End Sub

Funcao Date 2

Sub teste1()
'Acrescentar dias a uma data
Dim dataemissao As Date
Dim datavencimento As Date
Dim periodo As Integer
dataemissao = Date
periodo = CInt(InputBox("Quantos dias para o Vencimento"))
datavencimento = DateAdd("d", periodo, dataemissao)
MsgBox datavencimento
End Sub

Funcao Date

Sub teste()
Dim data As Date
data = CDate(InputBox("Digite a data que venceu a Duplicata : "))
'MsgBox Weekday(data)
'Diferença de dias entre uma data e outra
Dim dias As Integer
Dim meses As Integer
meses = DateDiff("m", data, Date)
dias = DateDiff("d", data, Date)
MsgBox dias
MsgBox meses
End Sub

Programinha Que Gera Uma Pilha Com Nome Digitado

Sub ExemploUltimoNome()
    Dim palavra As String
    palavra = UCase(InputBox("Digite uma palavra"))
    Dim i As Integer
    Dim mensagem As String
    For i = 1 To Len(palavra)
        mensagem = mensagem & Mid(palavra, 1, i) & Chr(13)
    Next
    MsgBox mensagem
End Sub

Programinha Que Seleciona Primeiro Nome e Ultimo Sobrenome

Sub comequeficosabendo()
    Dim palavra As String
    Dim letra As String
    palavra = UCase(InputBox("Digite uma palavra"))
    Dim pos_espaco As Integer
    pos_espaco = InStr(1, palavra, " ")
    Dim resultado As String
    resultado = Mid(palavra, 1, pos_espaco)
    MsgBox resultado
    resultado = Mid(palavra, InStrRev(palavra, " ") + 1, Len(palavra) - InStrRev(palavra, " "))
    MsgBox resultado
   
End Sub

Gerar um Jogo Para MegaSena Funções Internas

Sub Exemplo_Funcoes()
'gerar um numero randomico
'gerar um jogo para megaSena
Dim jogo(5) As Integer
Dim qtd As Integer
Dim gerado As Integer
Dim i As Integer
Dim tem As Boolean
Dim mensagem As String

qtd = 0
Do While (qtd < 6)
 gerado = Int(Rnd() * 60)
    For i = 0 To 5
    If gerado = jogo(i) Then tem = True
    Next
    If tem = False Then
    jogo(qtd) = gerado
    qtd = qtd + 1
    End If
Loop

For i = 0 To 5
mensagem = mensagem & jogo(i) & " "
Next

MsgBox mensagem

End Sub

Tabuada Vetor "Array"

Sub tabuadaVetorArray()
Dim A(10) As Integer
Dim i     As Integer
Dim n     As Integer
Dim m     As String

n = InputBox("Digite o Numero que Deseja a Tabuada: " & n + 1)
For i = 0 To 10
  A(i) = n * i
Next
For i = 0 To 10
m = m & n & " X " & i & " = " & A(i) & Chr(13)
Next

MsgBox m
End Sub

Exercicio Maromo Matriz Vetor

Sub MatrizVetor()
Dim v(6, 6) As Integer
Dim l     As Integer
Dim c     As Integer
Dim x     As String
Dim y     As String

For l = 0 To 6
  For c = 0 To 6
        v(l, c) = 1
   
      If l < c Then
        v(l, c) = 2
      End If
   
      If l > c Then
        v(l, c) = 0
      End If
   Next
 Next
 
 For l = 0 To 6
    For c = 0 To 6
    x = x & v(l, c)
    Next
 y = y + x
 x = ""
 y = y & Chr(13)
 Next

Debug.Print y

End Sub

Matriz Multidimencional

Sub MatrizMultidimencional()

'Representação de linha e coluna
'3x2 (3 linhas / 2 colunas)
'5x5 (5 linhas / 5 colunas)
'Dim matriz(2,1) as integer "Matriz de 3 linha 2 Coluna"
'Dim matriz(4,4) as integer "Matriz de 5 linhas 5 colunas"
' 5 nomes 2 Notas e a Media

 Dim nome(4) As String
 Dim resultado(4) As String
 Dim nota(4, 2) As Double
 Dim n As Integer
 Dim c As Integer
 Dim mensagem As String

'Alimentar os dados Vetor e Matriz
 For n = 0 To 4
 nome(n) = InputBox("Nome do Aluno" & n + 1)
 nota(n, 0) = CDbl(InputBox("Nota da Primeira Prova: " & nome(n)))
 nota(n, 1) = CDbl(InputBox("Nota da Segunda Prova: " & nome(n)))
 nota(n, 2) = (nota(n, 0) + nota(n, 1)) / 2

 If nota(n, 2) >= 6 Then
  resultado(n) = "Aprovado"
 Else
  resultado(n) = "Reprovado"
  End If
  Next
 
For n = 0 To 4
    mensagem = mensagem & "Nome : " & nome(n) & " Media : " & nota(n, 2) & " Situação : " & resultado(n) & Chr(13)
Next
    MsgBox mensagem
End Sub

Vetor de Ordenaçaõ Professor Maromo

Sub SubOrdenChoquito()
Dim v(4)  As Integer
Dim i     As Integer
Dim j     As Integer
Dim troca As Integer

For i = 0 To 4
v(i) = CInt(InputBox("Digite um Valor: "))
Next

For i = 0 To 4
    For j = 0 To 4
         If v(i) > v(j) Then
         troca = v(i)
         v(i) = v(j)
         v(j) = troca
         End If
    Next
Next

For i = 0 To 4
Debug.Print v(i)
Next
End Sub

Vetor Dinamico VBA Excel

Sub vetordinamico()
Dim v() As Integer
Dim q As Integer
Dim i As Integer
q = CInt(InputBox("Digite o Tamanho do vetor : "))
q = q - 1
ReDim v(q)
For i = 0 To q
    v(i) = CInt(InputBox("Digite um Valor: "))
Next

For i = 0 To q
Debug.Print v(i)
Next
   
End Sub

'Incrementa o Vetor com 10 Nomes , Imprime do Ultimo pro Primeiro Nome Digitado

Sub pratica1()
Dim nome(9) As String
Dim i As Integer


'Incrementa o Vetor com 10 Nomes
    For i = 0 To 9
    nome(i) = InputBox("Digiete o Nome : ")
    Next

'Imprime do Ultimo pro Primeiro Nome Digitado  
    For i = 9 To 0 Step -1
    MsgBox nome(i)
    Next


End Sub

Exemplo Vetor Imprimir e Contador

Sub ExemploVetor1()
Dim valor(6) As Integer
Dim i        As Integer
Dim conta   As Integer

'encrementar valor no vetor
For i = 0 To 6
valor(i) = CInt(InputBox(" Digite um valor"))
Next

'imprimir valores encrementados
For i = 0 To 6
    'selecionar impares
    If valor(i) Mod 2 = 1 Then

    'contar quantidades de Numeros Impares incrementados
    conta = conta + 1
        MsgBox valor(i)
    End If
Next
MsgBox "total de impares: " & conta
End Sub

Exemplo Vetor

Sub ExemploVetor()
Dim valor(6) As Integer
Dim i        As Integer

'encrementar valor no vetor
For i = 0 To 6
valor(i) = CInt(InputBox(" Digite um valor"))
Next

'imprimir valores encrementados
For i = 0 To 6
MsgBox valor(i)
Next

End Sub