ClubEnsayos.com - Ensayos de Calidad, Tareas y Monografias
Buscar

COmandos VBA Excel, List Object

Omar CalderónApuntes11 de Diciembre de 2019

617 Palabras (3 Páginas)175 Visitas

Página 1 de 3

SI(CONTARA(#¡REF!)=0,1,BUSCAR(10000,#¡REF!)+1)

Lista Desplegable Tabla Dinamica.

Horario_Diario = DESREF('Calendario de Citas'!A8,0,0,CONTARA('Calendario de Citas'!A8:A103)-CONTAR.SI('Calendario de Citas'!A8:A103,""))

Function BuscarDocIdentidad(Valor As Long) As Integer

Dim Rango As Range

Dim ValorBusqueda As Integer

Set Rango = Worksheets("Pacientes").Range("H:H")

ValorBusqueda = Application.WorksheetFunction.CountIf(Rango, Valor)

BuscarDocIdentidad = ValorBusqueda

End Function

----

Sub Buscar_Paciente()

Dim ValorBuscado As String

Dim busco As Object

Dim Numfilas As Integer

Dim FilaCopiada As Integer

ValorBuscado = Sheets("Registro_Cita").Range("G7").Value

Application.ScreenUpdating = False

'MsgBox (ValorBuscado = "")

'MsgBox ValorBuscado

Sheets("Registro_Cita").Visible = False

Sheets("Pacientes").Visible = True

Sheets("Pacientes").Select

Numfilas = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'MsgBox Numfilas

Set busco = Range("I3:I" & Numfilas).Find(ValorBuscado, LookAt:=xlWhole)

If busco Is Nothing Then

Sheets("Pacientes").Visible = False

Sheets("Registro_Cita").Visible = True

Sheets("Registro_Cita").Select

MsgBox "Paciente no encontrado"

Else

FilaCopiada = busco.Row

Copiar_RegCita (FilaCopiada)

End If

Application.ScreenUpdating = True

'MsgBox (busco Is Nothing)

'MsgBox (IsNumeric(busco))

End Sub

--------

Eliminar Servicio

-----

Sub Eliminar_Servicio()

Dim Tbl_Servicio As ListObject

Set Tbl_Servicio = Sheets("Registrar_Servicios").ListObjects("Tabla_Servicios")

Dim FilaEliminar As Integer

Dim FilaTotal As Integer

If Not Application.Intersect(ActiveCell, Tbl_Servicio.DataBodyRange) Is Nothing Then

Fila = Application.Intersect(ActiveCell, Tbl_Servicio.DataBodyRange).Row - 8

'MsgBox UltimaFila

MyDelete_Global "Tabla_Servicios", "Registrar_Servicios", Fila

'MsgBox Fila

End If

End Sub

--- Sheet active copiar tabla a otra hoja.

Private Sub Worksheet_Activate()

Dim Tbl_DB As ListObject

'Dim Tbl_Resumen As ListObject

Dim Areas As Integer

Dim Registros As Integer

Dim DataTabla As Range

Dim DataFila As Range

Set Tbl_DB = Sheets("Pacientes").ListObjects("Tabla_Pacientes")

'Set Tbl_Resumen = Sheets("Resumen_Pacientes").ListObjects("TablaResumen_Pacientes")

Registros = Tbl_DB.DataBodyRange.Rows.Count

Set DataTabla = Application.Union(Tbl_DB.ListColumns("ID_Paciente").DataBodyRange, Tbl_DB.ListColumns("Nombre y Apellidos").DataBodyRange, Tbl_DB.ListColumns("Celular").DataBodyRange)

Areas = DataTabla.Areas.Count

MsgBox "Areas: " & Areas

...

Descargar como (para miembros actualizados) txt (3 Kb) pdf (30 Kb) docx (9 Kb)
Leer 2 páginas más »
Disponible sólo en Clubensayos.com