Problema con distribución de datos según rango
Buenos días Equipo Excel Quería pedirles una ayuda tengo una duda en como plantear una solución a un inconveniente que estoy teniendo al momento de inicio quisiera seleccionar la zona en una lista desplegable al momento de seleccionarla, esta se escriba automáticamente líneas más abajo luego ingresar un monto se coloque líneas más abajo y de acuerdo a los rangos que se encuentran en la HOJA1, este haga que en una celda aparte como muestra el archivo jale la comisión. Añadiendo a esto se coloquen datos como muestra el archivo de excel y estos se distribuyan según el rango al cual pertenezcan. Adicionalmente me gustaría que si eligiera una zona más se cree la misma estructura filas más abajo. Espero puedan ayudarme en el excel esta un poco más detallado lo que se me ocurrió, cuento con conocimientos básicos en excel y creo que ustedes me podrían ayudar a ampliarlo
1 Respuesta
No pusiste tu archivo de excel, si gustas envíame tu archivo con los ejemplos desarrollados, explica cada ejemplo con datos, con colores, con imágenes y con comentarios.
Mi correo [email protected]
En el asunto del correo escribe: Corpunk y el título:"Problema con distribución de datos"
La siguiente macro va en los eventos de la hoja2
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("formato")
If Not Intersect(Target, [B3]) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
'
Application.EnableEvents = False
u = Range("A" & Rows.Count).End(xlUp).Row
If u < 13 Then u = 13
Set b = Range("A12:A" & u).Find(Target, LookAt:=xlWhole)
If Not b Is Nothing Then
f = b.Row
Else
If u = 13 Then
f = 13
Else
f = h2.Range("A" & Rows.Count).End(xlUp).Row + 5
End If
h3.Rows("1:10").Copy h2.Rows(f)
End If
'
h2.Cells(f, "A") = Target
h2.[B6].Select
Application.EnableEvents = True
End If
'
If Not Intersect(Target, [B6]) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If [B3] = "" Then
MsgBox "Antes de ingresar el valor, selecciona la zona", vbCritical, "ERROR!"
Target = ""
[B3].Select
Exit Sub
End If
'
Application.EnableEvents = False
u = Range("A" & Rows.Count).End(xlUp).Row
If u < 13 Then u = 13
Set b = Range("A12:A" & u).Find([B3], LookAt:=xlWhole)
If Not b Is Nothing Then
com = Application.VLookup(Target, h1.[B5:D17], 3, True)
If IsError(com) Then
MsgBox "El valor no es válido, captura un valor válido", vbCritical, "ERROR"
Target = ""
[B6].Select
Else
h2.Cells(b.Row + 1, "C") = h2.[B6]
h2.Cells(b.Row + 1, "J") = com
End If
Else
MsgBox "La zona no existe, captura una zona válida", vbCritical, "ERROR!"
Target = ""
[B3].Select
End If
Application.EnableEvents = True
End If
End SubSaludos.Dante Amor
No olvides valorar la respuesta
