Macro para ingresar en base de datos
Para Dante Amor. Quisiera una macro para ingresar datos en Hoja2 desde Hoja1. En Hoja1 un formulario que recogiese 3 datos: Nº socio, Fecha e Importe.
En la Hoja2 aparecería del siguiente modo la base de datos:
La macro ha de buscar según el Nº SOCIO insertado y una vez encontrado situar la FECHA DE INGRESO en las celdas vacías que encuentre a partir de E, G, I, K, M, O, Q, S, U y W. Por otra parte el campo de IMPORTE será insertado en la última celda vacía de las columnas F, H, J, L, N, P, R, T, V y X.
Recuerda que ya me hicistes una en la que buscaba nº cliente(socio) y situaba el cursor en la última celda vacía que encontraba a la derecha de su fila.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range("A2")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
u = Range("A" & Rows.Count).End(xlUp).Row
If u = 2 Then u = 5
Set b = Range("A5:A" & u).Find([A2], LookIn:=xlFormulas, LookAt:=xlWhole)
If Not b Is Nothing Then
c = Cells(b.Row, Columns.Count).End(xlToLeft).Column + 1
Cells(b.Row, c).Select
End If
End If
End Sub
1 Respuesta
Te anexo la macro, en la hoja1 deberás capturar los dato en las columnas A, B y C. Te anexo mi archivo para que veas el ejemplo.
La macro deberá ir en los eventos de la hoja1, cada que modifiques el importe de la columna "C" se actualizará la hoja2.
Si falta el número de socio o la fecha te enviará un mensaje de error.
Si el número de socio no existe, te enviará mensaje de error.
Si el importe es 0, te envía un mensaje de error.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Columns("C")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Cells(Target.Row, "A") = "" Then
MsgBox "Falta el número de socio", vbCritical
Target = ""
Cells(Target.Row, "A").Select
Exit Sub
End If
If Cells(Target.Row, "B") = "" Then
MsgBox "Falta la fecha", vbCritical
Target = ""
Cells(Target.Row, "B").Select
Exit Sub
End If
If Target.Value = 0 Then
MsgBox "Falta importe", vbCritical
Target = ""
Cells(Target.Row, "C").Select
Exit Sub
End If
Set h2 = Sheets("Hoja2")
Set b = h2.Columns("A").Find(Cells(Target.Row, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
uc = h2.Cells(b.Row, Columns.Count).End(xlToLeft).Column + 1
If uc < 5 Then uc = 5
h2.Cells(b.Row, uc) = Cells(Target.Row, "B")
h2.Cells(b.Row, uc + 1) = Cells(Target.Row, "C")
MsgBox "Datos actualizados"
Else
MsgBox "El número de socio no existe"
End If
End If
End Subhttps://www.dropbox.com/s/xdp189be4i4nj91/formato.xlsm?dl=0
Saludos. Dante Amor
¡Gracias! Muy buena respuesta. Como siempre
Se me olvidó haberte pedido también que insertase una columna adicional en dicha base de datos que fijara la diferencia entre las fechas (1º y última introducida) como hace la función =dias360(). Eso podría fijarse en una columna anterior al de la primera fecha (donde totalizaría esa diferencia entre 1ª fecha y última introducida).No sé si esto ya te marea mucho o supone simplemente una línea adicional al código. Sería que empezase la columna de las fechas de ingreso en F pues la E la reservariamos para poner la diferencia (=dias360) entre fechas
Cambia en la macro
If uc < 5 Then uc = 5
por
If uc < 6 Then uc = 6
Prueba y me comentas, si no te funciona crea una nueva pregunta para revisar la macro completa
¡Gracias! Sí, me permite insertar esa columna adicional para calcular la diferencia entre fechas. Pero me gustaría una fórmula ahora en dicha columna ("E" o 5) que me pusiese de forma automática la diferencia de días transcurridos entre la primera fecha y la última. Ya sabes que puedo hacerlo con la fórmula =dias360() pero claro he de fijarle yo las celdas donde se encuentran las 2 fechas
