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

COmandos VBA Excel, List Object


Enviado por   •  11 de Diciembre de 2019  •  Apuntes  •  617 Palabras (3 Páginas)  •  151 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

...

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