Jump to content

miguel.sme

Members
  • Content Count

    10
  • Joined

  • Last visited

  1. Como sólo son dos colores, y además un color en cada celda, he cambiado a esta macro: Sub concatenarycolor1() Dim uA, i& uA = Range("A" & Rows.Count).End(xlUp).Row For i = uA To 1 Step -1 If Cells(i, "A") <> 0 Or Cells(i, "A") <> "#n/d" Then Value1 = ActiveCell.Value Color1 = ActiveCell.Font.Color Len1 = Len(Value1) ActiveCell.Offset(0, 1).Range("A1").Select Value2 = ActiveCell.Value Color2 = ActiveCell.Font.Color Len2 = Len(Value2) ActiveCell.Offset(0, 1).Range("A1").Select ActiveCell.Value = Value1 & Chr(10) & Value2 With ActiveCell.Characters(Start:=1, Length:=Len1).Font .Color = Color1 End With With ActiveCell.Characters(Start:=Len1 + 2, Length:=Len2).Font .Color = Color2 End With ActiveCell.Offset(1, -2).Range("A1").Select End If Next i End Sub Pero encuentro un problema, no quiero unir las dos celdas que contengan un 0 o "#n/d" o un espacio en blanco. En ese caso sólo debería elegir el valor de la otra celda que tiene contenido disitinto a éstos. La que no tiene ese valor. Actualmente está uniendo ambas celdas en todos los casos. Adjunto ejemplo. concatenarycolor.XLSB
  2. Acabo de probarla, es la manera más veloz de eliminarlas de entre las varias macros que he ido probando. Muchas gracias Gerson.
  3. Muchas gracias Gerson, la pruebo también. Si algún día tienes un rato, me gustaría saber si esto se puede mejorar en términos de tiempo ya que al ir caracter a caracter se bloquea el ordenador: Gracias de antemano.
  4. Buenas tardes, tengo esta macro que lee caracter a caracter y los concatena con su mismo formato, en este caso concatena manteniendo color de ambas celdas. La he probado y es muy lenta cuando hay muchas lineas con muchos carcateres en cada celda. Como en realidad sólo tengo texto en dos colores que se encuentran siempre en celdas separadas, no sé si se podría optimizar y hacerla más rápida y ligera. Os copio el código y adjunto ejemplo: Sub COPYPASTECOLORINDEX() Set myRange = Range("A:B") 'aquí le digo el rango del aprimera columna For Each c In myRange.Cells If c.Value <> "" Then If c.Offset(0, 1).Value = "" Then c.Offset(0, 2).Value = c.Value Else c.Offset(0, 2).Value = c.Value & Chr(10) & c.Offset(0, 1).Value 'c.Offset(0, 2).Characters(Len(CStr(c.Value)) + 2, Len(CStr(c.Offset(0, 1).Value))).Font.ColorIndex = c.Offset(0, 1).Characters(Len(CStr(c.Value))).Font.ColorIndex End If End If For i = 1 To Len(CStr(c.Value)) c.Offset(0, 2).Characters(i, 1).Font.ColorIndex = c.Characters(i, 1).Font.ColorIndex Next i For j = 1 To Len(CStr(c.Offset(0, 1).Value)) c.Offset(0, 2).Characters(i + j, 1).Font.ColorIndex = c.Offset(0, 1).Characters(j, 1).Font.ColorIndex Next j Next c End Sub colores.xlsx.xlsm
  5. Sí, la verdad es que sin ejemplo debe ser difícil... os lo adjunto y describo con más detalle. Se trataría de filtrar y borrar a partir de la linea 3 que es la que clasifica lo que viene a continuación. Autofilter y borrar las localidades que no son ni albacete ni roma ,por ejemplo , desde la columna encabezada con Localidad. Gracias de antemano. Libro1.xlsx
  6. Hola de nuevo, en realidad, me interesa no borrar las filas que cumplan varios criterios. ¿Se puede fácilmente? Gracias.
  7. Buenos días, intento borrar filas metiendo varios criterios (texto) situados en una sóla columna mediante este código pero no consigo meter varios. Agradecería cualquier ayuda. Muchas Gracias de antemano: Sub ElimarFilaxCriterio() u = Cells(Rows.Count, 1).End(xlUp).Row qColumna = "x" qCriterio = "XXX", "YYY", "ZZZ" For i = u To 2 Step -1 Cells(i, qColumna).Select If Cells(i, qColumna) = qCriterio Then ActiveCell.EntireRow.Select Selection.Delete End If Next End Sub
  8. Muchas Gracia Gerson, ya funciona perfectamente. Saludos
  9. buenas tardes, el siguiente código no funciona dando error de definición de tipo. Agradecería cualquier ayuda : Sub enviar_adjunto() Dim OutApp As New Outlook.Application Dim OutMail As Object Sheets("XXX").Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\TempRangeForEmail.xlsx" Set OutApp = New Outlook.Application Set OutMail = OutApp.CreateItem(0) OutApp.Session.Logon With OutMail .To = "xxx@gmail.ES" .CC = "" .BCC = "" .Subject = "XXXXX" .Body = "Buenas tardes, se adjunta xxx" .Attachments.Add (ThisWorkbook.Path & "\TempRangeForEmail.xlsx") .Display End With Set OutApp = Nothing Set OutMail = Nothing End Sub
×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png