Manual Básico para
VBA
Investigación de Operaciones – 2014-I
Se presentan fundamentos básicos para programación en
VBA con ejemplos para cada estructura, operadores y
condiciones, estructuras y funciones. Se presentan
además ejemplos aplicativos para el curso de IOP.
Javier Navarro Hayashida
26/03/2014
MACROS BASICO
01. Ingreso de datos sin definir variables:
Sub Primero
Range("A1").Value = "Hola"
End Sub
Sub Segundo
[Link]("A1:A8").Value = "Hola"
[Link]("A1:A8").[Link] = True
[Link]("A1:A8").[Link] = RGB(255,0,0)
End Sub
02. Ingreso de datos usando variable tipo string:
Sub Entrar_Valor
Dim Casilla As String
Dim Texto As String
Casilla = InputBox("En que casilla quiere entrar el valor", "Entrar Casilla")
Texto = InputBox("Introducir un texto " & Chr(13) & "Para la casilla " & Casilla , "Entrada
de
datos")
[Link](Casilla).Value = Texto
End Sub
03. Ingreso de datos usando variable tipo integer:
Option Explicit
Sub Sumar()
Dim Numero1 As Integer
Dim Numero2 As Integer
Numero1 = Val(InputBox("Entrar el primer valor", "Entrada de datos"))
Numero2 = Val(InputBox("Entrar el primer valor", "Entrada de datos"))
[Link]("A1").Value = Numero1 + Numero2
End Sub
04. Tener en cuenta…
a. PROPIEDADES CELLS, ROW, COLUMN
[Link](1,1).Value="Hola" Comentado [JNH1]: El Range es reemplazado por el Cells, esto
Range(Cells(1, 1), Cells(8, 2)).Value = "Hola" es más útil para offset.
Range("A5:B10").Cells(2, 1).Value = "Hola"
Sub obj()
Dim R As Range
Set R = [Link]("A10:B15")
[Link] = "Hola"
[Link] = True
End Sub
b. PROPIEDAD OFFSET
[Link]("A1").Offset(2, 2).Value = "Hola" ' Casilla C3 = Hola, 2 filas y 2
columnas desde A1.
[Link](5,1).Value = "Hola" ' 5 Filas por debajo de la casilla Activa = Hola
[Link](2,2).Activate 'Activar la casilla que está 2 filas y 2 columnas de la
activa
05. Estructura Condicional If
Entrar una cantidad que representa el precio de algo por el teclado con la instrucción InputBox y guardarlo en la celda A1
de la hoja activa. Si el valor entrado desde el teclado (y guardado en A1) es superior a 1000, pedir descuento con otro
InputBox y guardarlo en la casilla A2 de la hoja activa. Calcular en A3, el precio de A1 menos el descuento de A2.
Option Explicit
Sub Condicional()
Dim Precio As Integer
Dim Descuento As Integer
Precio = 0
Descuento = 0
Precio = Val(InputBox("Entrar el precio", "Entrar"))
‘Si el valor de la variable precio es mayor que 1000, entonces, pedir descuento
If Precio > 1000 Then
Descuento = Val(InputBox("Entrar Descuento", "Entrar"))
End If
[Link]("A1").Value = Precio
[Link]("A2").Value = Descuento
[Link]("A3").Value = Precio - Descuento
End Sub
06. Estructura Condicional If-Else
Entrar una cantidad que representa el precio de algo por el teclado con la instrucción InputBox y guardarlo en la celda A1 de
la hoja activa. Si el valor entrado desde el teclado (y guardado en A1) es superior a 1000, se aplica un descuento del 10%
sino se aplica un descuento del 5%, el descuento se guarda en la casilla A2 de la hoja activa. Colocar en A3, el total
descuento y en A4 el total menos el descuento.
Sub Condicional_Else()
Dim Precio As Single, Descuento As Single
Worksheets(1).Activate
[Link](“A1”).Activate
Precio = 0
Precio = Val(InputBox("Entrar el precio", "Entrar"))
'Si el valor de la variable precio es mayor que 1000, entonces, aplicar descuento del 10%
If Precio > 1000 Then
Descuento = Precio * 0.1
Range("A2").Value = 0.1
Else ' Sino aplicar descuento del 5%
Descuento = Precio * 0.05
Range("A2").Value = 0.05
End If
Range("A1").Value = Precio
Range("A3").Value = Descuento
Range("A4").Value = Precio - Descuento
End Sub
07. Operadores Lógicos And & Or / ClearContents
Entrar el Nombre, la cantidad y el precio de un producto desde el teclado y guardarlos
respectivamente en A1, A2 y A3. Calcular el total y guardarlo en A4. Si el total es superior
a 10.000 y el nombre del producto es "Patatas", pedir un descuento, calcularlo el total
descuento y guardarlo en A5, luego restar el descuento del total y guardarlo en A6.
Sub Ejemplo_12()
Dim Producto As String
Dim Cantidad As Integer
Dim Precio As Single, Total As Single, Descuento As Single, Total_Descuento As Single
Precio = 0
Worksheets(“And”).Activate
[Link](“A1”).Activate
Producto = InputBox("Entrar Nombre del Producto","Entrar")
Precio = Val(InputBox("Entrar el precio", "Entrar"))
Precio = Val(InputBox("Entrar la cantidad", "Entrar"))
Total = Precio * Cantidad
Range("A1").Value = Producto
Range("A2").Value = Precio
Range("A3").Value = Cantidad
Range("A4").Value = Total
' Si total mayor que 10.000 y el producto es Patatas, aplicar descuento.
If Total > 10000 And Producto = "Patatas" Then Comentado [JNH2]: Para OL “Or”, cambiar sólo esta condición.
Descuento = Val(InputBox("Entrar Descuento", "Entrar"))
Total_Descuento = Total * (Descuento / 100)
Total = Total - Total_Descuento
[Link]("A5").Value = Total_Descuento
[Link]("A6").Value = Total
End If
End Sub
Sub Clear()
Sheets("And").Select
Range("A1:A6").Select
[Link]
End Sub
08. Operador Lógico Not
Entrar una cantidad que representa el precio de algo por el teclado con la instrucción
InputBox y guardarlo en la celda A1 de la hoja activa. Si el valor entrado desde el teclado
(y guardado en A1) es superior a 1000, pedir descuento con otro InputBox y guardarlo en la
casilla A2 de la hoja activa. Calcular en A3, el precio de A1 menos el descuento de A2.
Sub Ejemplo_14()
Dim Precio As Integer
Dim Descuento As Integer
Precio = 0
Descuento = 0
Precio = Val(InputBox("Entrar el precio", "Entrar"))
' Si el valor de la variable precio NO es menor igual 1000, entonces, pedir descuento
If Not (Precio <= 1000) Then
Descuento = Val(InputBox("Entrar Descuento", "Entrar"))
End If
[Link]("A1").Value = Precio
[Link]("A2").Value = Descuento
[Link]("A3").Value = Precio - Descuento
End Sub
09. Select Case: Aplica cuando hay varios If que hacen referencia a una misma celda, la cual puede
tener distintos valores.
Macro que suma, resta, multiplica o divide los valores de las casillas A1 y A2 dependiendo
de si B1 contiene el signo “+”, “-“, “x” ó “:”. El resultado lo deja en A3. Si en B1 no hay
ninguno de los signos anteriores en A3 debe dejarse un 0.
Sub Ejemplo_16()
Dim Signo As String
Dim Valor1 As Integer, Valor2 As Integer, Total As Integer
Valor1 = [Link]("A1").Value
Valor2 = [Link]("A2").Value
Signo = [Link](“B1").Value
Select Case signo
Case "+"
Total = Valor1 + Valor2
Case "-"
Total = Valor1 - Valor2
Case "x"
Total = Valor1 * Valor2
Case ":"
Total = Valor1 / Valor2
Case Else
Total = 0
End Select
[Link]("A3").Value = Total
End Sub
10. La función MsgBox y variable Boolean
<Ejemplo 07>; Si el precio es menor a S/.1.00, escribir un mensaje de error
indicado que el precio es menor a S/.1.00. La Macro se detiene en este punto y
no se ingresa ningún valor.
Option Explicit
Sub Operador_Logico_And()
Dim N As String, x As String Comentado [JNH3]: Para mensaje de error del MsgBox
Dim C As Single, P As Single, Pa As Single, D As Single, T As Single
Dim Continuar As Boolean
D = 0
Continuar = True
Worksheets("And").Activate
N = InputBox("Ingrese nombre del producto", "Nombre")
C = Val(InputBox("Ingrese cantidad a comprar del producto", "Cantidad"))
P = Val(InputBox("Ingrese precio del producto", "Precio"))
If P < 1 Then
x = MsgBox("El precio es menor a S/.1.00", vbOKOnly, "ERROR")
Continuar = False
Else
Pa = P * C
If Pa > 10000 And N = "Patatas" Then
D = InputBox("Ingrese descuento de las patatas", "Descuento")
End If
T = Pa - D
Range("A6").Value = N
Range("B6").Value = C
Range("C6").Value = P
Range("D6").Value = Pa
Range("E6").Value = D
Range("F6").Value = T
End If
End Sub
Sub Clear()
Sheets("And").Select
Range("A6:F6").Select
[Link]
End Sub
11. La instrucción With
<Ejemplo 07>
[Link]("A1").Value = Producto
[Link]("A2").Value = Precio
[Link]("A3").Value = Cantidad
[Link]("A4").Value = Total
Queda reemplazado por:
With ActiveSheet
.Range("A1").Value = Producto
.Range("A2").Value = Precio
.Range("A3").Value = Cantidad
.Range("A4").Value = Total Comentado [JNH4]: No olvidar colocar un “.” Al inicio de cada
End With sentencia.
12. Estructura Repetitiva “For / Next”
Entrar 10 valores utilizando la función InputBox, sumarlos y guardar el resultado en la
casilla A1 de la hoja activa.
Sub Ejemplo_21()
Dim i As Integer
Dim Total As Integer
Dim Valor As Integer
For i=1 To 10
Valor= Val(InputBox("Entrar un valor","Entrada"))
Total = Total + Valor
Next i
[Link]("A1").Value = Total
End Sub
Haciendo uso de la propiedad CELLS, ROW y COLUMN…
Supongamos que tenemos que hacer un programa para entrar las notas de una clase de 5 alumnos
que se guardarán respectivamente en las celdas de A1 a A5 de la hoja activa. Después hacer
la media que se guardará en A6.
Sub Ejemplo_24()
Dim Nota As Integer
Dim Media As Single
Dim Fila As Integer
Media = 0
For Fila = 1 To 5
Nota=Val(InputBox("Entrar la nota del alumno " & Fila & " :", "Entrar Nota"))
[Link](Fila, 1) = Nota
Media = Media + Nota
Next Fila
Media = Media / 5
[Link](6, 1).Value = Media Comentado [JNH5]: Usando Cells en vez de Range
End Sub
Haciendo uso de la propiedad OFFSET…
Sub Ejemplo_26()
Dim Nota As Integer
Dim Media As Single
Dim i As Integer
Media = 0
[Link]("A1").Activate
For i = 1 To 5
Nota=Val(InputBox("Entrar la " & i & " Nota : ", "Entrar Nota"))
[Link] = Nota
Media = Media + Nota
‘Hacer activa la casilla situada una fila por debajo de la actual
[Link](1, 0).Activate
Next Fila
Media = Media / 5
[Link] = Media
End Sub
Ingresar el valor de 10,000 en la Celda A1, luego, el valor de esta celda irá disminuyendo
en un 50% por 10 veces, registrando los 10 valores debajo de la celda A1.
Sub Operador_Repetitivo_For()
Dim i As Integer
Dim A As Single
Worksheets("For").Select 'Se puede colocar Activate en vez de Select
Range("A1").Select 'Se puede colocar Activate en vez de Select
A = 10000
[Link] = A
For i = 1 To 10
A = A / 2
[Link](i, 0).Value = A
Next i
End Sub
13. Estructura Repetitiva “Do While / Loop” ; “Do / Loop While”; “Do / Loop Until”
a. Do While / Loop
Programa para entrar registros en la base de datos. Cada campo se entra con InputBox. El
programa va pidiendo datos mientras se entre un valor en el InputBox correspondiente al
nombre, es decir cuando al preguntar el nombre no se entre ningún valor, terminará la
ejecución del bloque encerrado entre Do While...Loop. Observe la utilización de la propiedad
Offset para colocar los datos en las celdas correspondientes.
Sub Ejemplo_28()
Dim Nombre As String
Dim Ciudad As String
Dim Edad As Integer
Dim Fecha As Date
WorkSheets("Hoja1").Activate
[Link]("A1").Activate 'ActiveCell = “A1”
‘Buscar la primera celda vacía de la columna A y convertirla en activa
Do While Not IsEmpty(ActiveCell)
[Link](1,0).Activate
Loop
Nombre = InputBox("Entre el Nombre (Return para Terminar) : ", "Nombre")
‘Mientras la variable Nombre sea diferente a cadena vacía
Do While Nombre <> ""
Ciudad = InputBox("Entre la Ciudad : ", "Ciudad")
Edad = Val(InputBox("Entre la Edad : ", "Edad"))
Fecha=Cdate(InputBox("Entra la Fecha : ", "Fecha"))
With ActiveCell
.Value = Nombre
.Offset(0,1).Value = Ciudad
.Offset(0,2).Value = Edad
.Offset(0,3).value = Fecha
End With
[Link](1,0).Activate
Nombre = InputBox("Entre el Nombre (Return para Terminar) : ", "Nombre")
Loop
End Sub
b. Do / Loop While: La única diferencia es que te obliga a ejecutar las instrucciones del cuerpo
del bucle al menos una vez.
Do
Nombre = InputBox("Entre el Nombre (Return para Terminar) : ", "Nombre")
Ciudad = InputBox("Entre la Ciudad : ", "Ciudad")
Edad = Val(InputBox("Entre la Edad : ", "Edad"))
Fecha=Cdate(InputBox("Entra la Fecha : ", "Fecha"))
With ActiveCell
.Value = Nombre
.Offset(0,1).Value = Ciudad
.Offset(0,2).Value = Edad
.Offset(0,3).value = Fecha
End With
[Link](1,0).Activate
Nombre = InputBox("Entre el Nombre (Return para Terminar) : ", "Nombre")
Loop While Nombre <> “”
c. Do / Loop Until: Similar a la anterior (prácticamente lo mismo…)
Sub Do_LoopUntil()
Dim Nombre As String, Ciudad As String, Mas_Datos As String Comentado [JNH6]: Para el MsgBox
Dim Edad As Integer
Dim Fecha As Date
Worksheets("xD").Activate
[Link]("B18").Activate
Do While Not IsEmpty(ActiveCell)
[Link](1, 0).Activate
Loop
Do
Nombre = InputBox("Ingrese Nombre" & Chr(13) & "(o presione ENTER para terminar)",
"Nombre")
Ciudad = InputBox("Ingrese Ciudad", "Ciudad")
Edad = InputBox("Ingrese Edad", "Edad")
Fecha = InputBox("Ingrese Fecha", "Fecha")
With ActiveCell
.Value = Nombre
.Offset(0, 1).Value = Ciudad
.Offset(0, 2).Value = Edad
.Offset(0, 3).Value = Fecha
End With
Mas_Datos = MsgBox("¿Desea ingresar otro registro?", vbOKCancel, "Ingresar Datos")
[Link](1, 0).Activate
Loop Until Mas_Datos = vbCancel
End Sub
Tenemos un formulario donde se llenarán los datos sobre los avances de campo de
una obra de construcción de viviendas. Una vez llenado el formulario, se requiere
que los datos se almacenen en una base de datos que posteriormente pueda ser
usada para generar reportes de avance de viviendas por sector, manzana, lote y
partida (actividad).
Sub Llenar_BD()
' Llenar_BD Macro
Dim S As String
Dim M As String
Dim L As Integer
Dim P As String
Dim U As String
Dim C As Single
Sheets("Formulario").Select 'Así garantizamos que al correr la macro se dirija a esta hoja
S = Range("D23").Value
M = Range("D25").Value
L = Range("D27").Value
P = Range("D29").Value
U = Range("D31").Value
C = Range("D33").Value
If S = "" Or M = "" Or L = 0 Or P = "" Or U = "" Or C = 0 Then
MsgBox ("No ha llenado todas las casillas")
Else
Sheets("Base de datos").Select
Range("B7").Activate
'Verifica si la celda activa está vacía, de no estarlo, activa la celda una fila debajo
hasta encontrar una vacía.
Do While Not IsEmpty(ActiveCell)
[Link](1, 0).Activate
Loop
With ActiveCell
.Value = S
.Offset(0, 1).Value = M
.Offset(0, 2).Value = L
.Offset(0, 3).Value = P
.Offset(0, 4).Value = U
.Offset(0, 5).Value = C
End With
Sheets("Formulario").Select
Range("D23,D25,D27,D29,D33").Select
[Link]
End If
End Sub
14. Funciones (f(x))
Una función es lo mismo que un procedimiento con la salvedad que este devuelve un valor al procedimiento o
función que lo llama.
Ejemplo:
Función definida por ( , )= + −2 +
Que devuelve el valor de f(x,y) según los parámetros independientes (x,y) que se ingresan
manualmente desde el Excel.
Option Explicit
Sub FuncionXY()
Dim f As Double, x As Double, y As Double
x = Worksheets("fx").Range("A2").Value
y = Worksheets("fx").Range("B2").Value
f = fun(x, y)
Worksheets("fx").Range("C2").Value = f
End Sub
Function fun(a As Double, b As Double) As Double
fun = a ^ 2 + b ^ 2 - 2 * a * b + 2 * a ^ 3 / b ^ 5
End Function
La sintaxis es similar a la cabecera de un procedimiento, sólo que una función tiene tipo, esto tiene su lógica,
ya que una función devuelve un valor, ese valor será de un tipo determinado. Así, en nuestro ejemplo de
Function Fun, esta función es de tipo Double, o dicho de otra manera, la función ejecuta sus sentencias y
devuelve un valor hacia el procedimiento o la función que la llamó, el valor devuelto se establece igualando el
nombre de la función a algo.
METODO DE LA BISECCIÓN:
Option Explicit
Sub Biseccion()
Dim a As Double, b As Double, xr As Double, e As Double, eadm As Double
Dim i As Integer
Dim Xrant As Double
Sheets("Bisección").Activate
Range("B12").Activate
a = Range("C6").Value
b = Range("C7").Value
eadm = Range("C8").Value
i = 1
e = 100
If eadm = 0 Then
MsgBox ("Por favor insertar un Error mayor a 0%")
Exit Sub
Else
If fun(a) * fun(b) > 0 Then
MsgBox ("No existe raíz en este intervalo")
Exit Sub
Else
Do While Not IsEmpty(ActiveCell)
[Link](1, 0).Activate
Loop
Do
xr = (a + b) / 2
With ActiveCell
.Offset(i - 1, 0).Value = i
.Offset(i - 1, 1).Value = a
.Offset(i - 1, 2).Value = b
.Offset(i - 1, 3).Value = fun(a)
.Offset(i - 1, 4).Value = fun(b)
.Offset(i - 1, 5).Value = xr
.Offset(i - 1, 6).Value = fun(xr)
End With
If i > 1 Then
Xrant = [Link](i - 2, 5).Value
e = Abs((xr - Xrant) / xr * 100)
[Link](i - 1, 7).Value = e
End If
If fun(a) * fun(xr) > 0 Then
a = xr
Else
b = xr
End If
i = i + 1
Loop Until e < eadm
End If
End If
End Sub
Function fun(X As Double) As Double
fun = X ^ 2 - 5
End Function
Sub Limpiar()
[Link]
Range("C6:C9,B12:I1048576").Select
[Link]
End Sub
METODO DE REGULA FALSI:
Option Explicit
Sub Regla_Falsa()
Dim a As Double, b As Double, xr As Double, e As Double, eadm As Double, Xrant As Double
Dim i As Integer, maxi As Integer
Sheets("Regla Falsa").Activate
Range("B12").Activate
a = Range("C6").Value
b = Range("C7").Value
eadm = Range("C8").Value
maxi = Range("C9").Value
i = 1
e = 100
If eadm = 0 Then
MsgBox ("Por favor insertar un Error mayor a 0%")
Exit Sub
End If
If fun(a) * fun(b) > 0 Then
MsgBox ("No existe raíz en este intervalo")
Exit Sub
Else
Do While Not IsEmpty(ActiveCell)
[Link](1, 0).Activate
Loop
For i = 1 To maxi
xr = b - (fun(b) * (a - b)) / (fun(a) - fun(b))
With ActiveCell
.Offset(i - 1, 0).Value = i
.Offset(i - 1, 1).Value = a
.Offset(i - 1, 2).Value = b
.Offset(i - 1, 3).Value = fun(a)
.Offset(i - 1, 4).Value = fun(b)
.Offset(i - 1, 5).Value = xr
.Offset(i - 1, 6).Value = fun(xr)
End With
If i > 1 Then
Xrant = [Link](i - 2, 5).Value
e = Abs((xr - Xrant) / xr * 100)
[Link](i - 1, 7).Value = e
If e <= eadm Then
MsgBox ("Se encontró la raiz en la iteración " & i)
Exit Sub
End If
End If
If fun(a) * fun(xr) > 0 Then
a = xr
Else
b = xr
End If
Next
If e >= eadm Then
MsgBox ("Se requiere más de " & maxi & " iteraciones")
End If
End If
End Sub
Function fun(X As Double) As Double
fun = Log(X + 65) / (X ^ 6 + 8) - X ^ 4
End Function
