Generando folios en Excel
hola
En espera de su valioso apoyo en Excel con una MACROS, para generar Folios.
* los encabezados están de la celda A1 a H1
* los datos que voy ingresando manual están de la celda A2 a I1
* y el Resultado que Quiero que me de, esta en la celda I1 del ejemplo.
* no se si se pueda que cuando ponga la inicial A al darle clip en el botón de la macro, genere en automático AP como se muestra en la celda de folio
* al igual que cuando anote la inicial E y al darle clip en el botón de la macro genere en automático EGV tal como se anexa en la celda de resultado de folio.
anexo ejemplo:
A1 B1 C1 D1 E1 F1 G1 H1 I1
inicial numero dia mes año centro At dec Folio
A 01 14 06 13 3330 ad red 01-Ap-14-06-13-3330-ad-red
E 02 15 06 13 3330 aa ade 02-EGV-15-06-13-3330-aa-ade
A 03 16 06 13 3330 ab red 03-Ap-16-06-13-3330-ab-red
en espera del apoyo
saludos
1 Respuesta
Con esta macro, cada vez que escribas el último dato, en este caso, cuando escribas el dato en la columna H, en automático te pone el folio en la columna I.
Prueba y me comentas
Sigue las Instrucciones para poner la macro en worksheet
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
4. Del lado derecho copia la macro
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
If Not Intersect(Target, Columns("H")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
f = Target.Row
If Cells(f, "A") = "A" Then a = "Ap"
If Cells(f, "A") = "E" Then a = "Egv"
Cells(f, "I") = Cells(f, "B") & a & Cells(f, "C") & _
Cells(f, "D") & Cells(f, "E") & Cells(f, "F") & _
Cells(f, "G") & Cells(f, "H")
End If
End Sub Saludos.DAM
Si es lo que necesitas.
HOLA
DAM
exelente aporte es lo que andaba buscando
nada mas un detalle no se si se pueda el resultado en Folio, me da el resultado todo junto anexo ejemplo
01Ap1406133330adred
me gustaría que lleve un guion
* asi me gustaría que quedara si se puede.
01-Ap-14-06-13-3330-ad-red
* y de ahi todo lo demás esta excelente es el único detallito que tengo que lleve el guion.
por tu apoyo
saludos
Si es cierto, me faltaron los guiones
Cambia la macro por esta:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.DAM
If Not Intersect(Target, Columns("H")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
f = Target.Row
If Cells(f, "A") = "A" Then a = "Ap"
If Cells(f, "A") = "E" Then a = "Egv"
Cells(f, "I") = _
Cells(f, "B") & "-" & _
a & "-" & _
Cells(f, "C") & "-" & _
Cells(f, "D") & "-" & _
Cells(f, "E") & "-" & _
Cells(f, "F") & "-" & _
Cells(f, "G") & "-" & _
Cells(f, "H")
End If
End SubSaludos.DAM
Si es lo que necesitas.
