
Type CADALUNO
Nome(8) As String
nota1(8) As Single
nota2(8) As Single
nota3(8) As Single
nota4(8) As Single
End Type


Type CADALUNO2
Nome As String
nota(4) As Single
End Type

Type SALARIOS
cod As Integer
CARGO As String
SAL As Currency
End Type

Type AGENDA
Nome As String
Telefone(3) As String
End Type


Sub CADASTRO_ALUNOS()
Dim i As Integer
Dim aluno As CADALUNO
Dim C As String
C = "CADASTRO ALUNOS"
'LER
For i = 1 To 8
aluno.Nome(i) = InputBox("Nome do Aluno " & i, C)
aluno.nota1(i) = InputBox("Nota 1 do Aluno " & aluno.Nome(i), C)
aluno.nota2(i) = InputBox("Nota 2 do Aluno " & aluno.Nome(i), C)
aluno.nota3(i) = InputBox("Nota 3 do Aluno " & aluno.Nome(i), C)
aluno.nota4(i) = InputBox("Nota 4 do Aluno " & aluno.Nome(i), C)
Next
'ESCREVER
For i = 1 To 8
Cells(i + 1, 1) = aluno.Nome(i)
Cells(i + 1, 2) = aluno.nota1(i)
Cells(i + 1, 3) = aluno.nota2(i)
Cells(i + 1, 4) = aluno.nota3(i)
Cells(i + 1, 5) = aluno.nota4(i)
Next
Cells(1, 1) = "Aluno"
Cells(1, 2) = "nota 1"
Cells(1, 3) = "nota 2"
Cells(1, 4) = "nota 3"
Cells(1, 5) = "nota 4"
End Sub

Sub CADASTRO_ALUNOS2()
Dim aluno(8) As CADALUNO2
Dim i, j, ln, cl As Integer
ln = 12
cl = 7
'INICIO
'LER
For i = 1 To 8
aluno(i).Nome = Cells(ln + i, cl)
For j = 1 To 4
aluno(i).nota(j) = Cells(ln + i, cl + j)
Next
Next
'ESCREVER
For i = 1 To 8
Cells(ln + i, cl + 15) = aluno(i).Nome
For j = 1 To 4
Cells(ln + i, cl + j + 15) = aluno(i).nota(j)
Next
Next
End Sub

Sub CADASTRO_ALUNOS3()
Dim aluno(8) As CADALUNO2
Dim x As CADALUNO2
Dim i, j, AT, PX, ln, cl As Integer
ln = 12
cl = 7
'INICIO
'LER
For i = 1 To 8
aluno(i).Nome = Cells(ln + i, cl)
For j = 1 To 4
aluno(i).nota(j) = Cells(ln + i, cl + j)
Next
Next
'ORDENAO
For AT = 1 To 7
For PX = AT + 1 To 8
If aluno(AT).Nome > aluno(PX).Nome Then
x = aluno(AT)
aluno(AT) = aluno(PX)
aluno(PX) = x
End If
Next
Next
'ESCREVER
For i = 1 To 8
Cells(ln + i, cl + 20) = aluno(i).Nome
For j = 1 To 4
Cells(ln + i, cl + j + 20) = aluno(i).nota(j)
Next
Next
End Sub

Sub TABELA_SALARIOS()
Dim TABELA(17) As SALARIOS
Dim ln, cl, i, cod As Integer
Dim acha As Boolean
ln = 430
cl = 1
'LER
For i = 1 To 17
TABELA(i).cod = i
TABELA(i).CARGO = Cells(i, 1)
TABELA(i).SAL = Cells(i, 2)
Next
'pesquisa
cod = InputBox("Codigo", "Cargos e Salarios")
i = 1
acha = False
Do While i <= 17 And acha = False
If cod = TABELA(i).cod Then
acha = True
Else
i = i + 1
End If
Loop
If acha = True Then
MsgBox TABELA(i).CARGO & Chr(10) & TABELA(i).SAL, , "Cargos e Salarios"
Else
MsgBox "Esse codigo no existe"
End If
End Sub


Sub agenda_telefone()
Dim ag(10) As AGENDA
Dim t As String
Dim C As Integer
t = "Agenda"
C = InputBox("digite o codigo", t)
ag(C).Nome = InputBox("nome", t)
ag(C).Telefone(1) = InputBox("Telefone Residencial", t)
ag(C).Telefone(2) = InputBox("Telefone Comercial", t)
ag(C).Telefone(3) = InputBox("Celular", t)
Cells(C + 1, 21) = ag(C).Nome
Cells(C + 1, 22) = ag(C).Telefone(1)
Cells(C + 1, 23) = ag(C).Telefone(2)
Cells(C + 1, 24) = ag(C).Telefone(3)
End Sub

Sub agenda_telefones_ordena()
Dim ag(10) As AGENDA
Dim x As AGENDA
Dim ln, cl, i, j As Integer
ln = 1
cl = 21
'LER
For i = 1 To 10
ag(i).Nome = Cells(ln + i, cl)
For j = 1 To 3
ag(i).Telefone(j) = Cells(ln + i, cl + j)
Next
Next
'ORDENAO
For AT = 1 To 9
For PX = AT + 1 To 10
If ag(AT).Nome > ag(PX).Nome Then
x = ag(AT)
ag(AT) = ag(PX)
ag(PX) = x
End If
Next
Next
'ESCREVER
For i = 1 To 10
Cells(ln + i, cl) = ag(i).Nome
For j = 1 To 3
Cells(ln + i, cl + j) = ag(i).Telefone(j)
Next
Next
End Sub

Type Conjunto
Elemento As Variant
acha As Boolean
End Type

Sub Unio_de_2_Conjuntos()
Dim a(100) As Conjunto
Dim b(100) As Conjunto
Dim C(200) As Conjunto
Dim D As Conjunto
Dim i, j As Integer
'ler elementos
For i = 1 To 100
    a(i).Elemento = Cells(i, 1)
    If a(i).Elemento <> "" Then
       a(i).acha = True
       Else
       a(i).acha = False
    End If
    b(i).Elemento = Cells(i, 2)
    If b(i).Elemento <> "" Then
       b(i).acha = True
       Else
       b(i).acha = False
    End If
Next
'indentificando elementos que pertencentes a A e B
For i = 1 To 100
    For j = 1 To 100
    If a(i).Elemento = b(j).Elemento Then
       a(i).acha = True
       b(j).acha = False
    End If
    Next
Next
'montando conjunto resposta
j = 1
For i = 1 To 100
    If a(i).acha = True Then
       C(j).Elemento = a(i).Elemento
       j = j + 1
    End If
    If b(i).acha = True Then
       C(j).Elemento = b(i).Elemento
       j = j + 1
    End If
Next
For i = 1 To 200
    If C(i).Elemento <> "" Then
       C(i).acha = True
       Else
       C(i).acha = False
    End If
Next

'ordenao
For i = 1 To 199
For j = i + 1 To 200
If C(i).acha = True And C(j).acha = True Then
If C(i).Elemento > C(j).Elemento Then
D = C(i)
C(i) = C(j)
C(j) = D
End If
Else
If C(i).acha = False And C(j).acha = True Then
D = C(i)
C(i) = C(j)
C(j) = D
End If
End If
Next
Next

'saida
For i = 1 To 200
    Cells(i, 3) = C(i).Elemento
    Next
End Sub
Sub Unio_de_3_Conjuntos()
Dim a(100) As Conjunto
Dim b(100) As Conjunto
Dim C(100) As Conjunto
Dim D(300) As Conjunto
Dim E As Conjunto
Dim i, j As Integer
'ler elementos
For i = 1 To 100
    a(i).Elemento = Cells(i, 1)
    If a(i).Elemento <> "" Then
       a(i).acha = True
       Else
       a(i).acha = False
    End If
    b(i).Elemento = Cells(i, 2)
    If b(i).Elemento <> "" Then
       b(i).acha = True
       Else
       b(i).acha = False
    End If
    C(i).Elemento = Cells(i, 3)
    If C(i).Elemento <> "" Then
       C(i).acha = True
       Else
       C(i).acha = False
    End If
Next
'indentificando elementos que pertencentes a A , B e C
For i = 1 To 100
    For j = 1 To 100
    If a(i).Elemento = b(j).Elemento Then
       b(j).acha = False 'se j est no grupo A...
    End If
    If a(i).Elemento = C(j).Elemento Then
       C(j).acha = False
    End If
    If b(i).Elemento = C(j).Elemento Then
       C(j).acha = False
    End If
    Next
Next
'montando conjunto resposta
j = 1
For i = 1 To 100
    If a(i).acha = True Then
       D(j).Elemento = a(i).Elemento
       j = j + 1
    End If
    If b(i).acha = True Then
       D(j).Elemento = b(i).Elemento
       j = j + 1
    End If
    If C(i).acha = True Then
       D(j).Elemento = C(i).Elemento
       j = j + 1
    End If
Next
For i = 1 To 300
    If D(i).Elemento <> "" Then
       D(i).acha = True
       Else
       D(i).acha = False
    End If
Next

'ordenao
For i = 1 To 299
For j = i + 1 To 300
If D(i).acha = True And D(j).acha = True Then
If D(i).Elemento > D(j).Elemento Then
E = D(i)
D(i) = D(j)
D(j) = E
End If
Else
If D(i).acha = False And D(j).acha = True Then
E = D(i)
D(i) = D(j)
D(j) = E
End If
End If
Next
Next

'saida
For i = 1 To 300
    Cells(i, 4) = D(i).Elemento
Next
End Sub

Sub Interseco_de_2_Conjuntos()
Dim a(100) As Conjunto
Dim b(100) As Conjunto
Dim C(100) As Variant
Dim i, j As Integer
For i = 1 To 100
a(i).Elemento = Cells(i, 1)
a(i).acha = False
b(i).Elemento = Cells(i, 2)
b(i).acha = False
Next
For i = 1 To 100
For j = 1 To 100
If a(i).Elemento = b(j).Elemento Then
a(i).acha = True
b(j).acha = True
End If
Next
Next
j = 1
For i = 1 To 100
If a(i).acha = True Then
C(j) = a(i).Elemento
j = j + 1
End If
Next
For i = 1 To 100
Cells(i, 3) = C(i)
Next
End Sub
Sub Diferena_de_2_Conjuntos()
Dim a(100) As Conjunto
Dim b(100) As Conjunto
Dim C(100) As Variant
Dim i, j As Integer
'ler
For i = 1 To 100
a(i).Elemento = Cells(i, 1)
If a(i).Elemento <> "" Then
a(i).acha = True
Else
a(i).acha = False
End If
b(i).Elemento = Cells(i, 2)
Next
'calculando
For i = 1 To 100
For j = 1 To 100
If a(i).Elemento = b(j).Elemento Then
a(i).acha = False
End If
Next
Next
'resposta
j = 1
For i = 1 To 100
If a(i).acha = True Then
C(j) = a(i).Elemento
j = j + 1
End If
Next
For i = 1 To 100
Cells(i, 3) = C(i)
Next
End Sub
