Jump to content

jhon fredy

Members
  • Posts

    81
  • Joined

  • Last visited

Everything posted by jhon fredy

  1. gracias maestro como puedo agregarlo al codigo de arriba para que funcione en un solo codigo
  2. hola expertos buenas tardes mi idea es bordear aquellas celdas que su numero sea igual a su posicion en los cuadros tanto arriba como abajo como lo muestro en la imagen con las celdas rojas Sub resaltar() ' ' Resaltar Macro ' Resalta similitudes https://foro.todoexcel.com/threads/bordear-celdas-de-acuerdo-a-posicion.55559/#post-237370 ' ' Acceso directo: CTRL+q ' Sheets("Hoja2").Select F1 = Asc(Range("A2").Value) f2 = Asc(Range("A3").Value) C1 = Range("B2").Value C2 = Range("B3").Value For J = 0 To 7 ' numero de Columnas Debug.Print "Siguiente Fila " If J Mod 2 = 0 Then Debug.Print "Esta si la hago :" & J For i = 0 To 9 ' numero de filas Debug.Print Range(Chr(F1 + J) & C1 + i).Address & " : " & Range(Chr(F1 + J) & C1 + i).Value Debug.Print Range(Chr(F1 + J) & C2 + 9 - i).Address & ": " & Range(Chr(F1 + J) & C2 + 9 - i).Value If Range(Chr(F1 + J) & C1 + i).Value = Range(Chr(F1 + J) & C2 + 9 - i).Value Then resaltarCelda (Sheets("Hoja2").Range(Chr(F1 + J) & C1 + i)) resaltarCelda (Sheets("Hoja2").Range(Chr(F1 + J) & C2 + 9 - i)) End If Next i Else Debug.Print "Esta No la hago :" & J End If Next J MsgBox "Proceso Terminado" End Sub Sub resaltarCelda(r As Range) r.Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub
  3. como puedo hacer para que se marquen las celdas en columnas intermedias si el numero esta en la misma posicion tanto arriba como abajo MarcaSimilitudes (3).xlsm
  4. hola buenas tardes como puedo marcar aquellas celdas que coincidan tanto en el primero como en el segundo cuadro de numeros y lo marque de olor rojo como se muestra en el ejemplo MarcaSimilitudes (3).xlsm
  5. hola buenos dias maestros mi idea es la siguiente tengo en una columna un listado de numeros de cuatro cifras en mi ejemplo columna N y necesito resaltar aquellos numeros de las tres ultimas cifras en el rango e1:k40
  6. hola expertos buenas noches mi idea es como podremos distribuir 800 numeros que se encuentran en la columna A pasarlos a la columna E en grupos de 40 numeros por columna
  7. aunque me gustaria hacer otro translado de datos ya subo el libro
  8. tengo unos datos en la hoja2 y me gustaria extraerlos como se muestra el ejemplo en la hoja proyecto2.xlsm
  9. tengo los siguientes codigos y me gustaria tener la opcion de ejecutarlos la cantidad de veces que sea necesario por ejemplo call aleato call zero ejecutar la siguiente cantidad de veces ( ) Sub Aleato() borrar_anteriores With Application .ScreenUpdating = False .DisplayAlerts = False '-- ufila99 = 1 + Hoja99.Cells(Rows.Count, 1).End(xlUp).Row tf = Sheets("estadisticas").UsedRange.Rows.Count tc = Sheets("estadisticas").UsedRange.Columns.Count '-- For x = 6 To 37 Do: f = Int((tf * Rnd) + 1) c = Int((tc * Rnd) + 1) Loop Until Sheets("estadisticas").Cells(f, c) <> "" Sheets("analisis").Range("B" & x) = CDbl(Sheets("estadisticas").Cells(f, c)) Sheets("analisis").Range("B" & x).NumberFormat = "0000" Sheets("estadisticas").Cells(f, c).Interior.Color = vbYellow Hoja99.Cells(ufila99, 1).Value = f Hoja99.Cells(ufila99, 2).Value = c ufila99 = ufila99 + 1 Next '-- .ScreenUpdating = True .DisplayAlerts = True End With End Sub Sub zero() Dim ultimaCeldaDatos As String 'hallar la ultima celda con datos de la columna B de la hoja estadistica ultimaCeldaDatos = Sheets("analisis").Cells(Rows.Count, 2).End(xlUp).Row 'copiando datos de columna B Sheets("analisis").Range("b5:b" & ultimaCeldaDatos).Copy Sheets("archivo").Select 'posicionando en la celda donde pegare los datos en la hoja archivo Sheets("archivo").Cells(2, Columns.Count).End(xlToLeft).Offset(0, 2).Select Selection.PasteSpecial Application.CutCopyMode = False 'copiando datos de las columnas de Estadísticas Descriptivas de la hoja estadistica Sheets("analisis").Range("q7:r19").Copy Sheets("archivo").Select 'posicionando en la celda donde pegare los datos en la hoja archivo Sheets("archivo").Cells(2, Columns.Count).End(xlToLeft).Offset(0, 2).Select Selection.PasteSpecial xlPasteValues 'configurando el borde y tamaño de las columnas de Estadísticas Descriptivas Selection.Borders.Weight = XlBorderWeight.xlThin Selection.ColumnWidth = 20 Application.CutCopyMode = False End Sub
  10. hola expertos tengo el siguiente formulario creado por el maestro antoni y lo que hace es que al seleccionar dicho rango arroja un numero en la celda az1 de acuerdo a la suma de dichas celdas sreleccionadas pero me gustaria cambiar la idea al reves que al colocar un numero en az1 se buscara el rango correspondiente para dar con ese numero division entre.xlsm
  11. hasta ahora en avanzado en este codigo pero necesito que se ejecute en la hoja activa , he tratado con activesheets y no se ejecuta , alguna otra idea? Sub resaltar() Sheets("hoja2").Select f1 = Asc(Range("AK2").Value) f2 = Asc(Range("AK3").Value) C1 = Range("AL2").Value C2 = Range("AL3").Value For J = 0 To 7 'numeros de columnas Debug.Print "siguiente fila" If J Mod 2 = 0 Then Debug.Print "esta si la hago :" & J For i = 0 To 9 'numero de filas Debug.Print Range("A" & Chr(f1 + J) & C1 + i).Address & " : " & Range("A" & Chr(f1 + J) & C1 + i).Value Debug.Print Range("A" & Chr(f1 + J) & C2 + 9 - i).Address & ": " & Range("A" & Chr(f1 + J) & C2 + 9 - i).Value If Range("A" & Chr(f1 + J) & C1 + i).Value = Range("A" & Chr(f1 + J) & C2 + 9 - i).Value Then resaltarCelda (Sheets("hoja2").Range("A" & Chr(f1 + J) & C1 + i)) resaltarCelda (Sheets("hoja2").Range("A" & Chr(f1 + J) & C2 + 9 - i)) End If Next i Else Debug.Print "esta no la hago :" & J End If Next J MsgBox "proceso terminado" End Sub Sub resaltarCelda(r As Range) r.Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .TintAndShade = 0 .Weight = xlMedium End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone End Sub
  12. como puedo modificar este codigo ,para que se ejecute en el rango "ap2: aw25" , y se ejecute en columnas intermedias , o sea ap,ar, at y av MarcaSimilitudes.xlsm
  13. hola expertos buenas tardes mi idea es la siguiente tengo un rango de numeros rango "bh1:dl120" y me gustaria resaltar aquellos numeros que se repiten en dicho rango
  14. hola experto buenas tardes espero que la esten pasando bien , por casualidad alguno de ustedes tienen un codigo con la siguiente caracteristica lo que pasa es que necesito extraer un listado de numeros de acuerdo a la posicion de color del cuadro de la primer hoja y si es posible resaltarlos le agradeceria de antemano muchas gracias prueba.xlsm
  15. maestro que pena contestarle hasta ahora , los numeros son de 4 cifras desde 0000 hasta 9999 y mi idea es eliminar los numeros primos que estan en mi rango a1.sx42
  16. hola expertos mi idea es , si existe algun codigo que elimine los numeros primos en un rango en mi caso "a1:sx42" les agradezco mucho
  17. muchas gracias maestro bigpetroman excente trabajo gracias por su tiempo y dedicacion
  18. como puedo agregarle al codigo para que realice la busqueda de derecha a izquierda y igualmente en diagonal hacia la izquierda sopa de letras.xlsm
  19. aunque tengo demasiados datos para agrupar , habra algo mas rapido
  20. hola expertos me pueden por favor colaborar con los siguientes dos codigostengo un rango de datos numericos que van desde "a1:sx42" pero hay varias celdas vacias y necesito agrupar todos esos datos en una columna en mi caso "ut"y el segundo codigo seria que elimine las celdas vacias de la columna utle agradezco que los codigos sean lo mas rapido posible al ejecutarse
×
×
  • Create New...

Important Information

Privacy Policy