Principales respuestas
Seleccionar datos en macro Excel

Pregunta
-
Bueno les cuento espero puedan ayudarme,
tengo una macro creada en Excel 2013 la cual en el evento Worksheet_SelectionChange al posicionarme en una celda de la columna "producto" se muestra el contenido de esta misma en otra celda.
Bueno lo que necesito es que al posicionarme en una celda, por ejemplo en la celda del "producto 3" en la hoja1, busque todos los Productos de "productos 3" que estén en la hoja2 y que me los muestre en otra hoja incluyendo el valor y el margen.
HOJA1
producto Valor Margen producto 1 1200 2 producto 2 1201 4 producto 3 1202 6 producto 4 1203 8 producto 5 1204 10 producto 6 1205 12 producto 7 1206 14 HOJA2
producto Valor Margen producto 1 1200 2 producto 1 1500 3 producto 1 5622 5 producto 2 1201 4 producto 3 1202 6 producto 3 2530 8 producto 4 1203 8 producto 5 1204 10 producto 6 1205 12 producto 7 1206 14 así deberia quedar la Hoja3 al hacer click a la celda de "producto 3" en la hoja1
producto Valor Margen producto 3 1202 6 producto 3 2530 8 Ojalá puedan ayudarme se los agradecería mucho!!
Saludos!!
Francisco Vera B.
Respuestas
-
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next Dim Ws1 As Worksheet 'Hoja1 Dim Ws2 As Worksheet 'Hoja2 Dim WsD As Worksheet 'Hoja3 Dim i As Long 'Para recorrer las filas de la hoja 2 'como no sabemos cuantas filas hay elegimos 'Long por si acaso Dim j As Long 'Para recorrer las filas de la hoja 3 'como no sabemos cuantas filas hay elegimos 'Long por si acaso 'Salimos si: ' La columna de la seleccion no es la primera ' La fila de la seleccion es la primera ' Se seleccionan mas de una celda ' Se selecciona una celda vacia If Target.Column <> 1 Or Target.Row = 1 Or Target.Count > 1 Or _ Len(Target) = 0 Then Exit Sub On Error GoTo ErrHandler 'Congelamos la pantalla para acelerar el propceso Application.ScreenUpdating = False Set Ws1 = Me Set Ws2 = ThisWorkbook.Worksheets("Hoja2") Set WsD = ThisWorkbook.Worksheets.Add i = 2 j = 2 'Encabezados de la hoja 3 WsD.Cells(1, 1) = "Producto" WsD.Cells(1, 2) = "Valor" WsD.Cells(1, 3) = "Margen" 'Buscamos en la Hoja2 hasta encontrarnos con una celda vacia Do Until Len(Ws2.Cells(i, 1)) = 0 If Ws2.Cells(i, 1) = Target Then WsD.Cells(j, 1) = Ws2.Cells(i, 1) WsD.Cells(j, 2) = Ws2.Cells(i, 2) WsD.Cells(j, 3) = Ws2.Cells(i, 3) j = j + 1 End If i = i + 1 Loop WsD.Select Application.ScreenUpdating = True Exit Sub ErrHandler: Application.ScreenUpdating = True MsgBox "Ha habido un error a lo largo de la ejecución de la macro. " & _ "Esta no ha podido ser ejecutada en su totalidad.", vbOKOnly + _ vbCritical, "Atención" End Sub
Más mascado imposible, jeje. Espero haberte podido ayudar.
Un saludo.
Working Into Binary (WIB) - http://workingintobinary.blogspot.com.es/
- Propuesto como respuesta Albert Álvarez viernes, 19 de julio de 2013 10:31
- Marcado como respuesta fverab viernes, 19 de julio de 2013 13:22
Todas las respuestas
-
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next Dim Ws1 As Worksheet 'Hoja1 Dim Ws2 As Worksheet 'Hoja2 Dim WsD As Worksheet 'Hoja3 Dim i As Long 'Para recorrer las filas de la hoja 2 'como no sabemos cuantas filas hay elegimos 'Long por si acaso Dim j As Long 'Para recorrer las filas de la hoja 3 'como no sabemos cuantas filas hay elegimos 'Long por si acaso 'Salimos si: ' La columna de la seleccion no es la primera ' La fila de la seleccion es la primera ' Se seleccionan mas de una celda ' Se selecciona una celda vacia If Target.Column <> 1 Or Target.Row = 1 Or Target.Count > 1 Or _ Len(Target) = 0 Then Exit Sub On Error GoTo ErrHandler 'Congelamos la pantalla para acelerar el propceso Application.ScreenUpdating = False Set Ws1 = Me Set Ws2 = ThisWorkbook.Worksheets("Hoja2") Set WsD = ThisWorkbook.Worksheets.Add i = 2 j = 2 'Encabezados de la hoja 3 WsD.Cells(1, 1) = "Producto" WsD.Cells(1, 2) = "Valor" WsD.Cells(1, 3) = "Margen" 'Buscamos en la Hoja2 hasta encontrarnos con una celda vacia Do Until Len(Ws2.Cells(i, 1)) = 0 If Ws2.Cells(i, 1) = Target Then WsD.Cells(j, 1) = Ws2.Cells(i, 1) WsD.Cells(j, 2) = Ws2.Cells(i, 2) WsD.Cells(j, 3) = Ws2.Cells(i, 3) j = j + 1 End If i = i + 1 Loop WsD.Select Application.ScreenUpdating = True Exit Sub ErrHandler: Application.ScreenUpdating = True MsgBox "Ha habido un error a lo largo de la ejecución de la macro. " & _ "Esta no ha podido ser ejecutada en su totalidad.", vbOKOnly + _ vbCritical, "Atención" End Sub
Más mascado imposible, jeje. Espero haberte podido ayudar.
Un saludo.
Working Into Binary (WIB) - http://workingintobinary.blogspot.com.es/
- Propuesto como respuesta Albert Álvarez viernes, 19 de julio de 2013 10:31
- Marcado como respuesta fverab viernes, 19 de julio de 2013 13:22
-