Actividad 1
creación de Agenda personal con "Private Type"
Option Explicit
Private Type agenda
nombre As String
apellido As String
cpostal As Integer
End Type
Dim x As Integer
Sub datosagenda()
'llenar datos primer persona
Dim personas(1 To 3) As agenda
personas(1).nombre = "Juan"
personas(1).apellido = "Matinez"
personas(1).cpostal = "20256"
'segunda persona
personas(2).nombre = "Jorge"
personas(2).apellido = "Quezada"
personas(2).cpostal = 20000
'tercer persona
personas(3).nombre = "Victor"
personas(3).apellido = "Guerrero"
personas(3).cpostal = 20430
For x = 1 To 3
Cells(x, 1) = personas(x).nombre
Cells(x, 2) = personas(x).apellido
Cells(x, 3) = personas(x).cpostal
Next x
End Sub
Actividad 2Lista de estudiantes
Sub librito()
Dim estudiantes(1 To 4) As agenda
For x = 1 To 4
estudiantes(x).nombre = Application.InputBox("Dame tu nombre ", "Nombre")
estudiantes(x).apellido = Application.InputBox("Dame tu apellido: ", "Apellido")
estudiantes(x).cpostal = Application.InputBox("Dame tu C.P:", "Codigo postal")
Next x
'Range("A1") = "Nombre"
'Range("B1") = "Apellido"
'Range("C1") = " C.Postal"
For x = 1 To 4
Cells(x, 1) = estudiantes(x).nombre
Cells(x, 2) = estudiantes(x).apellido
Cells(x, 3) = estudiantes(x).cpostal
Next x
End Sub
Arreglo unidimensional
Sub tabla()
Dim arr(5) As Double
Dim arr2(5) As Double
Dim arr3(5) As Double
Dim arr4(5) As Double
Dim i As Integer
Range("A1") = "Dato"
Range("B1") = "Seno"
Range("C1") = "Dato+seno"
For i = 0 To 4
arr(i) = Application.InputBox("Dame dato: " & i + 1)
Cells(i + 2, 1) = arr(i)
arr2(i) = Sin(arr(i))
Cells(i + 2, 2) = arr2(i)
arr3(i) = arr(i) * arr2(i)
Cells(i + 2, 3) = arr3(i)
arr4(i) = arr(i) + arr2(i) + arr3(i)
Cells(i + 2, 4) = arr4(i)
Next i
End Sub
Actividad 4
Realización de Matriz Uno
Option Explicit
Sub matuno()
Dim r As Integer
Dim c As Integer
Dim d As Double
Dim mat(1 To 3, 1 To 4) As Double
For r = 1 To 3
For c = 1 To 4
'MsgBox (r & "-" & c)
' Cells(r, c) = r & c
Cells(r, c) = Application.InputBox("dame un dato: ")
Next c
Next r
End Sub
Realización de matriz DOS
Sub matdos()
Dim mat2(1 To 5, 1 To 4) As Double
Dim r, c As Integer
For r = 1 To 5
For c = 1 To 4
If c = 1 Then
mat2(r, c) = Application.InputBox("Dame dato >: ")
Cells(r, c) = mat2(r, c)
End If
If c = 2 Then
mat2(r, c) = mat2(r, c - 1) + Sin(mat2(r, c - 1))
Cells(r, c) = mat2(r, c)
End If
If c = 3 Then
mat2(r, c) = mat2(r, c - 2) + mat2(r, c - 1)
Cells(r, c) = mat2(r, c)
End If
If c = 4 Then
mat2(r, c) = mat2(r, c - 3) + mat2(r, c - 2) + mat2(r, c - 1)
Cells(r, c) = mat2(r, c)
End If
Next c
Next r
End Sub
diagonal principal de una matriz
Sub diagprincipal()
Dim mat(1 To 3, 1 To 3) As Integer
Dim i, j As Integer
For i = 1 To 3
For j = 1 To 3
If i = j Then
mat(i, j) = Application.InputBox("Dame un dato " & i & j & ": ")
Cells(i, j) = mat(i, j)
Else
mat(i, j) = 0
Cells(i, j) = mat(i, j)
End If
Next
Next i
End Sub
Diagonal inversa de una matriz
Sub diaginvertida()
Dim mati(1 To 3, 1 To 3)
Dim i, j As Integer
For i = 1 To 3
For j = 1 To 3
If i = 1 And j = 3 Then
mati(i, j) = Application.InputBox("Dame un dato " & i & j & ": ")
Cells(i, j) = mati(i, j)
Else
mati(i, j) = 0
Cells(i, j) = mati(i, j)
If i = 2 And j = 2 Then
mati(i, j) = Application.InputBox("Dame un dato " & i & j & ": ")
Cells(i, j) = mati(i, j)
Else
mati(i, j) = 0
Cells(i, j) = mati(i, j)
If i = 3 And j = 1 Then
mati(i, j) = Application.InputBox("Dame un dato " & i & j & ": ")
Cells(i, j) = mati(i, j)
Else
mati(i, j) = 0
Cells(i, j) = mati(i, j)
End If
End If
End If
Next j
Next i
End Sub
Programa para llenar matriz y realización de cálculos
Nota: se deben insertar 3 botones en usando "Userform"
Dim mat(1 To 3, 1 To 3) As Integer
Dim i, j As Integer
Private Sub CommandButton1_Click()
For i = 1 To 3
For j = 1 To 3
mat(i, j) = Application.InputBox("Dame dato:")
Cells(i, j) = mat(i, j)
Next j
Next i
End Sub
Private Sub CommandButton2_Click()
Dim sp As Integer
sp = 0
For i = 1 To 3
For j = 1 To 3
If i = j Then
sp = sp + Cells(i, j)
End If
Next j
Next i
Range("D1") = "Suma diagonal principal"
Range("D2") = sp
End Sub
Private Sub CommandButton3_Click()
Dim sdi As Integer
sdi = 0
For i = 1 To 3
For j = 1 To 3
If i = 1 And j = 3 Then
sdi = sdi + Cells(i, j)
Else
If i = 2 And j = 2 Then
sdi = sdi + Cells(i, j)
Else
If i = 3 And j = 1 Then
sdi = sdi + Cells(i, j)
End If
End If
End If
Next j
Next i
Range("D3") = "Suma diagonal invertida"
Range("D4") = sdi
End Sub
Matrices MMULT y MDETERM
Matriz con rotación de un rectángulo
Actividad 11
función "APELLIDO"
Function APELLIDO(x As String) As String
APELLIDO = Right(x, Len(x) - InStr(x, " "))
End Function
función "Base de un rectángulo"
Function AREA(base As Double, altura As Double)
'dar 3 numeros doubles de entrada
AREA = base * altura
End Function
EXAMEN UNIDAD 5
Matriz de 5X5 con un boton que pida calcular el promedio.
Para la matriz crear un modulo nuevo
Sub matuno()
Dim r As Integer
Dim c As Integer
Dim d As Double
Dim mat(1 To 5, 1 To 5) As Double
For r = 1 To 5
For c = 1 To 5
'MsgBox (r & "-" & c)
' Cells(r, c) = r & c
Cells(r, c) = Application.InputBox("dame un dato: ")
Next c
Next r
End Sub
Para el promedio colocar un boton "Active X"
Private Sub CommandButton1_Click()
Dim prom As Double
Dim i, j As Integer
Dim c As Integer
prom = 0
For i = 1 To 5
For j = 1 To 5
prom = Cells(i, j) + prom
Next j
Cells(i, 7) = prom / 5
prom = 0
Next i
End Sub
Comentarios
Publicar un comentario