No logro descubrir el error en mi código
He estado trabajando en un código para buscar un encabezado que el usuario seleccione de un combox, el problema es que el código no encuentra el encabezado (aunque este exista), se supone que la macro debe buscar encabezado y se llevara los items que le pertenezcan a otra hoja, en caso de no encontrar el elemento arrojara un mensaje diciendo "Error al agregar los Accesorios" pero como dije siempre arroja ese mensaje, exista o no exista el elemento, acá les muestro el código que uso
Private Sub cmdagacc_Click()
Set h1 = Sheets("MEMORIAS ACTO") 'Origen
Set h2 = Sheets("EMPALMES") 'Destino
Set R1 = h1.Range("CJ29")
Set R2 = h1.Range("CJ87")
Evn = cbxtacc.Value
Dim rng As Range
If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
MsgBox "Seleccione un tipo de Accesorio"
cbxtacc.SetFocus
Exit Sub
End If
Existe = False
Dim R As Object
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlWhole)
'For Each b In Range("CJ29:CK87").Cells
If Not b Is Nothing Then
cl = b.Address
Do
Fila = b.Row + 1
k = 2
For j = Cells("CJ29").Cells To Columns("CK87").Column
If h1.Cells(Fila, j).Value = cbxtacc.Value Then
Existe = True
Fila = Fila + 1
k = k + 1
Do While h1.Cells(Fila, j).Value <> ""
h2.Cells(k, "B").Value = h1.Cells(Fila, j).Value
h2.Cells(k, "C").Value = h1.Cells(Fila, j + 1).Value
Fila = Fila + 1
k = k + 1
Loop
Exit For
End If
Next
Loop While Not b Is Nothing And b.Address <> cl
End If
'Next
If Existe = False Then
MsgBox "Error al agregar los Accesorios", vbExclamation
Else
MsgBox "Accesorios agregados", vbInformation
End If
Range("A1") = "Empalmes"
End SubComo ven incluso trate de cambiar el ciclo If Not b Is Nothing Then por un For Each, pero no funciono lo único que cambia es que el segundo ciclo me genera el error 1004 en esta linea
Para darme a entender mejor estos son los pasos que sigue la macro:
- Busca el encabezado que el usuario seleccione de un combobox
- Va una hoja llamada "EMPALMES" y busca ese encabezado y selecciona los elementos que le pertenecen, así:
- Se lleva esos elementos y los pega de esta forma:
- Y si no encuentra el encabezado sale este mensaje
Reitero que el problema esta en que siempre sale ese mensaje aunque el encabezado exista, agradezco cualquier ayuda que me puedan dar para corregir o modificar mi código y que haga lo que quiero
1 Respuesta
El encabezado existe pero no es tal cual a lo que seleccionas en el combobox.
Esta instrucción dice que encuentre el texto completo:
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlWhole)Pero en tu caso debe buscarlo dentro de algo más de texto, entonces podrías utilizar:
Set b = h1.Range("CJ29:CK87").Find(Evn & "*", LookIn:=xlValues, LookAt:=xlWhole)
o de este modo:
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlPart)
Probá cual es la que mejor te va y luego regresa a valorar la respuesta o comenta nuevamente.
Elsa gracias por tu respuesta, intente con las 2 opciones que me ofreces y en ambos casos ocurre lo mismo, sale el mensaje como si no hubiera encontrado el código
Si colocaras en True la variable 'Existe' luego de la búsqueda notarás que sí lo encuentra...
If Not b Is Nothing Then cl = b.Address
pero lo tenés dentro de un bucle .... y allí nuevamente estás buscando que el texto de cada celda del rango sea = al valor del combo.... y aquí nuevamente debes buscarlo con * .
If h1.Cells(Fila, j).Value = cbxtacc.Value Then 'sabiendo que Even = cbxtacc reemplazarlo por Even & "*'
Revisa el resto del código por si hay otras líneas donde reemplazar ese texto.
Sdos!
Lamento que hayas valorado la respuesta cuando aún tenés código para arreglar. Espero que una vez resuelto el tema cambies tu valoración.
Sdos!
Elsa no logró comprender lo último que me dices lo de los ciclos, este es el código con las adecuaciones que me comentas (o como yo las entendí)
Set h1 = Sheets("MEMORIAS ACTO") 'Origen
Set h2 = Sheets("EMPALMES") 'Destino
Set R1 = h1.Range("CJ29")
Set R2 = h1.Range("CJ87")
Evn = cbxtacc.Value
Dim rng As Range
If cbxtacc.Value = "" Or cbxtacc.ListIndex = -1 Then
MsgBox "Seleccione un tipo de Accesorio"
cbxtacc.SetFocus
Exit Sub
End If
Existe = False
Dim R As Object
'Set b = h1.Range("CJ29:CK87").Find(Evn & "*", LookIn:=xlValues, LookAt:=xlWhole)
Set b = h1.Range("CJ29:CK87").Find(Evn, LookIn:=xlValues, LookAt:=xlPart)
'For Each b In Range("CJ29:CK87").Cells
If Not b Is Nothing Then
cl = b.Address
Existe = True
Do
Fila = b.Row + 1
k = 2
For j = Cells("CJ29").Cells To Columns("CK87").Column
If h1.Cells(Fila, j).Value = Evn & "*" Then
'If h1.Cells(Fila, j).Value = cbxtacc.Value Then
' Existe = True
Fila = Fila + 1
k = k + 1
Do While h1.Cells(Fila, j).Value <> ""
h2.Cells(k, "B").Value = h1.Cells(Fila, j).Value
h2.Cells(k, "C").Value = h1.Cells(Fila, j + 1).Value
Fila = Fila + 1
k = k + 1
Loop
Exit For
End If
Next
Loop While Not b Is Nothing And b.Address <> cl
End If
'Next
If Existe = False Then
MsgBox "Error al agregar los Accesorios", vbExclamation
Else
MsgBox "Accesorios agregados", vbInformation
End If
Range("A1") = "Empalmes"Pero ahora me sale el erro '9' "Sub indice fuera de intervalo".
Y claro que cambiare mi voto, solo que me parece muy feo dejar una respuesta sin valorar... aunque pude haber votado como excelente de primera mano, supongo que no lo pensé :p
En mi opinión se les pide la valoración al final para que la consulta no nos siga apareciendo como abierta y para que otros usuarios sepan que el código es correcto... pero cada uno puede interpretarlo a su modo ;)
Enviame tu libro para ajustarlo (mi correo gmail es cibersoft. Arg ) o dejame uno tuyo.
Sdos!
Ya te he enviado el archivo, el asunto es "Archivo problema", si tienes alguna duda o no tienes algo claro acerca de las hojas o los formularios con gusto tratare de aclararte las dudas. De antemano Muchas gracias
Te comento por mail las dificultades para descargar el libro...
Te dejo explicada la parte del código que debes modificar a partir de la línea del Set.
Observa cómo se indica el rango a recorrer en el bucle For j = Range...
Y también observa qué te indicará la variable Existe dependiendo de dónde coloques la instrucción con valor True. Dejé las 3 opciones ... lo correcto es la tercera.
Set b = h1.Range("CJ29:CK87").Find(Evn & "*", LookIn:=xlValues, LookAt:=xlWhole)
'For Each b In Range("CJ29:CK87").Cells
If Not b Is Nothing Then
cl = b.Address
Existe = True 'aquí indica que lo encontró .... aún no lo pasó
Do
Fila = b.Row 'debe guardar la fila del título para poder comparar
k = 2
For j = Range("CJ29").Column To Range("CK87").Column 'Ajustada
If h1.Cells(Fila, j).Value Like Evn & "*" Then 'compara los textos que inician con el valor del combo
Existe = True 'si dejas la variable aquí te indicará que hay alguna fila para copiar
Fila = Fila + 1
k = k + 1
Do While h1.Cells(Fila, j).Value <> ""
h2.Cells(k, "B").Value = h1.Cells(Fila, j).Value
h2.Cells(k, "C").Value = h1.Cells(Fila, j + 1).Value
Existe = True 'recién aquí tenés certeza de que algún registro fue copiado
Fila = Fila + 1
k = k + 1
Loop
Exit For
End If
Next
Loop While Not b Is Nothing And b.Address <> cl
End If
'Next
If Existe = False Then
MsgBox "Error al agregar los Accesorios", vbExclamation
Else
MsgBox "Accesorios agregados", vbInformation
End If
End SubSdos!
