UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se puede subir archivos al foro, favor de hacerlo en servidor externo (Dropbox, Drive...) y dejan link. "Sin archivo no hay respuestas"

Favor de leer "Todos los temas" Click aquí.

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1RESUELTO Buscar y devolver fila el 27/05/18, 02:49 pm

soripame

avatar
Buenos días foro,
He estado buscando en la red un macro que me ayude a buscar un dato en un libro y me devuelva el link donde se encuentra, resulta que trabajo con empaque y después de tener un libro con mas de 50 hojas se hace tedioso manualmente, encontré uno el cual trabaja de maravillas, emocionada lo agregue, a mi libro de trabajo, la sorpresa es que trabaja hasta 3 hojas, después de eso se queda  y nunca termina. Me he atrevido a solicitar su ayuda; que me indiquen por favor donde esta el error, de acuerdo a las reglas del foro tengo que subir el archivo, pero no tengo cuenta, podrían indicarme por favor y perdonen mi atrevimiento
1. Cual es el error
2. Donde puedo subir el archivo gratis

Agrego el código a continuación
Sub Busqueda_en_todas_las_hojas()
Dim Libro As Workbook, Hj As Worksheet
Dim C As Range, FirstCell As String
Range("B9:F" & [F65536].End(xlUp).Offset(10).Row).Delete xlShiftUp
Application.ScreenUpdating = False

  
  For Each Hj In Worksheets
  If Hj.Name <> ActiveSheet.Name Then
    If Range("B4") <> "" Then
    Set C = Hj.Cells.Find(What:=[B4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("C4") <> "" Then
    Set C = Hj.Cells.Find(What:=[C4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("D4") <> "" Then
    Set C = Hj.Cells.Find(What:=[D4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("E4") <> "" Then
    Set C = Hj.Cells.Find(What:=[E4], LookIn:=xlValues, LookAt:=xlPart)
    
    End If
    End If
    End If
    End If
    End If
 If C Is Nothing Then GoTo ProximaHoja
    FirstCell = C.Address
    Do
      With [B65536].End(xlUp).Offset(1).Resize(1, 5)
        .Cells = Array(Hj.Name & "" & C.Address, C.Value, C.Offset(0, 1).Value, C.Offset(0, 2).Value, C.Offset(0, 3).Value)
        ActiveSheet.Hyperlinks.Add Anchor:=.Cells, Address:="", SubAddress:=C.Address(External:=True)
      End With
      Set C = Hj.Cells.FindNext(C)
    Loop Until FirstCell = C.Address
ProximaHoja:
  Next Hj
  
Set C = Nothing
Range("B9:F" & [F65536].End(xlUp).Offset(10).Row).Font.Size = 12
Application.ScreenUpdating = True

End Sub 

Nota: Gracias por su gentileza
Atte.,
sorimape

2RESUELTO Re: Buscar y devolver fila el 27/05/18, 02:54 pm

Igtelo

avatar
Tienes una cuenta de coreo, por tanto te ofrece ese servicio, sólo es cuestión de que busques en las opciones...

Ignacio Téllez

3RESUELTO Link el 27/05/18, 10:41 pm

soripame

avatar
Buenas noches, gracias, este es el link
 https://drive.google.com/file/d/1NZQLWg2qCjicYbBeRYRTRleArNhVm_zz/view
Se llama empaque, no sabia que se podia hacer

Que foro, tan excepcional

soripame

4RESUELTO Re: Buscar y devolver fila el 28/05/18, 01:58 pm

Igtelo

avatar
Hola Soripame.

Por la noche lo veo.

Saludos
Ignacio Téllez

5RESUELTO Gracias el 28/05/18, 05:04 pm

soripame

avatar
Buenas Tardes,
Gracias Ignacio, muy amable


soripame

6RESUELTO Re: Buscar y devolver fila el 28/05/18, 05:27 pm

ateneo


Sub Busqueda_en_todas_las_hojas()
Dim Libro As Workbook, Hj As Worksheet
Dim C As Range, FirstCell As String
Range("B9:F" & [F65536].End(xlUp).Offset(10).Row).Delete xlShiftUp
Application.ScreenUpdating = False

  
  For Each Hj In Worksheets
  If Hj.Name <> ActiveSheet.Name Then
    If Range("B4") <> "" Then
    Set C = Hj.Cells.Find(What:=[B4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("C4") <> "" Then
    Set C = Hj.Cells.Find(What:=[C4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("D4") <> "" Then
    Set C = Hj.Cells.Find(What:=[D4], LookIn:=xlValues, LookAt:=xlPart)
    Else
    If Range("E4") <> "" Then
    Set C = Hj.Cells.Find(What:=[E4], LookIn:=xlValues, LookAt:=xlPart)
    
    End If
    End If
    End If
    End If
  
' If C Is Nothing Then GoTo ProximaHoja
    FirstCell = C.Address
    Do
      With [B65536].End(xlUp).Offset(1).Resize(1, 5)
        .Cells = Array(Hj.Name & "" & C.Address, C.Value, C.Offset(0, 1).Value, C.Offset(0, 2).Value, C.Offset(0, 3).Value)
        ActiveSheet.Hyperlinks.Add Anchor:=.Cells, Address:="", SubAddress:=C.Address(External:=True)
      End With
      Set C = Hj.Cells.FindNext(C)
    Loop Until FirstCell = C.Address


ProximaHoja:
    End If

Set C = Nothing

Range("B9:F" & [F65536].End(xlUp).Offset(10).Row).Font.Size = 12
Application.ScreenUpdating = True

Next Hj
End Sub

Sub LimpiarClearContents()
'***** Limpia solo el contenido mas no el formato hecho
Range("A9:I65536").ClearContents
Range("B4").Select
    Selection.ClearContents
End Sub

7RESUELTO Re: Buscar y devolver fila el 28/05/18, 09:38 pm

Igtelo

avatar
Hola Soripame / Ateneo.

Ateneo, muchas gracias por tu participación y por favor síguele, lo mismo le pedí a Excelboy, hay momentos en que ya no aguanto...

Te dejo otra usando filtro avanzado, NO te lleva a la celda sólo a la hoja dando doble click, en el archivo explico.  Estando en la hoja ya te es más fácil trabajar y no "recargas" la hoja con tanto hipervínculo.

Como no podemos subir archivos aquí en el foro, también dejo los códigos. Módulo2 y en hoja Buscador, allí hay un evento para el doble click.

Código:
Sub FiltroAvanzado()
Dim hoja As Worksheet, w As Integer  'Definición de variables

Application.ScreenUpdating = False
[B9:F35000] = ""                     'Limpia el rango
For Each hoja In Worksheets           'Para cada hoja
  w = [C35000].End(xlUp).Row + 1  'Última fila vacía en hoja Buscador
  If hoja.Name <> ActiveSheet.Name Then  'Si la hoja es distinta de Buscador entonces
   hoja.[A2:D30000].AdvancedFilter 2, [B3:E4], Cells(w, 3), 0  ' Ver sintaxis de AdvancedFilter en la ayuda de VBA
  Rows(w).EntireRow.Delete           'Elimina fila correspondiente a variable w
  Cells(w, 2) = hoja.Name             'Pone nombre de hoja en celda correspondiente
  End If                              'Cierre del condicional If
    Next                              'Repite hasta terminar con todas las hojas
Application.ScreenUpdating = False

End Sub

Sub ir_a_Hoja()
Dim dato As String

'Posicionar cursor en cualquier celda con dato en columna C
'Obviamente en hoja "Buscador"
'Ejecutar con doble click botón derecho del mouse

With ActiveCell
If .Column <>3 Then Exit Sub

If .Offset(, -1) = "" Then
 dato = .Offset(, -1).End(xlUp)
 Sheets(dato).Activate
Else
 dato = .Offset(, -1)
 Sheets(dato).Activate
End If
End With

End Sub
'NOTA:
'Esta macro es muy sencilla sólo trabaja con Offset.

Link para bajar archivo:

[url=https://www.dropbox.com/s/cwnrkxugf80fbxx/Soripame-Empaque-Filtro avanzado.xlsm?dl=0]https://www.dropbox.com/s/cwnrkxugf80fbxx/Soripame-Empaque-Filtro%20Avanzado.xlsm?dl=0[/url]

Saludos
Ignacio Téllez

8RESUELTO Gracias son ecepcionales el 28/05/18, 11:45 pm

soripame

avatar
Buenas Noches,
Me siento muy agradecida, gracias Ignacio y a todos; los dos son ecepcionales, ya no se cual usar, quisiera utilizar ambos, entonces uno lo utilizare en un archivo y el otro en otro similar.
Buena noches y gracias
soripame

9RESUELTO Disculpas el 28/05/18, 11:50 pm

soripame

avatar
Ateneo,
Disculpas porque ya esta como resuelto el tema, pero tenia que decirte , Muchas gracias no te imaginas el favor que me han hecho, gracias equipo


soripame

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.