¿Rellenar y actualizar formulario con datos en tiempo real?
Tengo un libro con varias hojas, desde la hoja "Presentacion" con un botón lanzo este formulario llamado "AsistentesPDCA".
En la hoja "MasterDATA" encontramos los datos que añadiremos a los diferentes ListBox.
La primera vez de uso no habrá datos, así que le incorporaremos a mano...¿Cómo?
En NewCargo (TextBox) ponemos "Tecnico" en NewDpto (TextBox) "Mantenimiento" y en NewAsistente "Martin Sheen" . Al pulsar "Nuevo Asistente" debera gravarse en la hoja "MasterDATA" en las correspondientes celdas correspondientes.
No dejara introducir Nombres de asistentes repetidos
Además se actualizara el dato en los 3 ListBox apreciendo el Cargo (no duplicados), Dpto (no duplicados) y Asistente ordenados alfabéticamente.
Os muestro como se guardarían los datos.
Todo esto lo tengo en Access pero el proyecto lo precisan en Excel y tengo que reconvertir todas las funciones...
¿Cómo y por donde puedo comenzar con este proyecto?
1 respuesta
Prueba lo siguiente:
Pon todo el código dentro de tu userform
Option Explicit
'
Dim nombres As New Collection
Dim sh As Worksheet
'
Private Sub CommandButton1_Click()
Dim f As Range
Dim lr As Long, i As Long
'VALIDACIONES
If NewCargo = "" Then
MsgBox "Captura Cargo"
NewCargo.SetFocus
Exit Sub
End If
If NewDpto = "" Then
MsgBox "Captura Depto"
NewDpto.SetFocus
Exit Sub
End If
If NewAsistente = "" Then
MsgBox "Captura Asistente"
NewAsistente.SetFocus
Exit Sub
End If
Set f = sh.Range("C:C").Find(NewAsistente, , xlValues, xlWhole, , , False)
If Not f Is Nothing Then
MsgBox "Ya existe el nombre"
NewAsistente.SetFocus
Exit Sub
End If
'
lr = sh.Range("A" & Rows.Count).End(3).Row + 1
sh.Range("A" & lr).Value = NewCargo
sh.Range("B" & lr).Value = NewDpto
sh.Range("C" & lr).Value = NewAsistente
'
If lr = 2 Then
ListBox1.AddItem sh.Range("A2").Value
ListBox2.AddItem sh.Range("B2").Value
ListBox3.AddItem sh.Range("C2").Value
Else
ListBox1.List = sh.Range("A2:A" & lr).Value
ListBox2.List = sh.Range("B2:B" & lr).Value
For i = 2 To lr
Call agregar(sh.Range("C" & i).Value)
Next
Dim a As Variant
ReDim a(1 To nombres.Count)
For i = 1 To nombres.Count
a(i) = nombres(i)
Next
ListBox3.List = a
End If
End Sub
Sub agregar(dato)
'Por.Dante Amor agrega orden alfabético
Dim i As Long
For i = 1 To nombres.Count
Select Case StrComp(nombres(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe, no lo agrega
Case 1: nombres.Add dato, Before:=i: Exit Sub 'agrega antes
End Select
Next
nombres.Add dato 'lo agrega al final
End Sub
Private Sub UserForm_Initialize()
Dim lr As Long, i As Long
Dim a As Variant
'
Set sh = Sheets("MasterDATA")
lr = sh.Range("A" & Rows.Count).End(3).Row
'
If lr = 1 Then
Exit Sub
ElseIf lr = 2 Then
If sh.Range("A2").Value <> "" Then
ListBox1.Value = sh.Range("A2").Value
ListBox2.Value = sh.Range("B2").Value
ListBox3.Value = sh.Range("C2").Value
End If
Else
ListBox1.List = sh.Range("A2:A" & lr).Value
ListBox2.List = sh.Range("B2:B" & lr).Value
For i = 2 To lr
Call agregar(sh.Range("C" & i).Value)
Next
ReDim a(1 To nombres.Count)
For i = 1 To nombres.Count
a(i) = nombres(i)
Next
ListBox3.List = a
End If
End Sub[No olvidar valorar la respuesta.
