Modificar libro en excel con condiciones

Para elsa:

Maestra elsa colabore con modificar las macros de la hoja pista, pistadia y hoja 2

1 Respuesta

Respuesta
1

A continuación dejo las macros arregladas para las 3 hojas mencionadas. Van juntas en el módulo llamado Mod_hoja2_pista_pistadia.

Sub buscar_reemplazar_borde2()
'arreglada x Elsamatilde    'Dbre'2021
  Set sh1 = Sheets("Hoja1")
  Set rng2 = Sheets("Hoja2").Range("A1:AB42")   'antes AA42
  For i = 1 To sh1.Range("J" & Rows.Count).End(xlUp).Row
    nrox = Format(sh1.Range("J" & i) & sh1.Range("K" & i) & _
                  sh1.Range("L" & i) & sh1.Range("M" & i), "0000")
    If InStr(1, nrox, "X", vbTextCompare) = 0 And nrox <> "" Then
      sh1.Range("O" & Rows.Count).End(3)(2) = nrox
    End If
  Next i
  '
  rng2.Borders.LineStyle = xlNone
  For Each c In sh1.Range("O2", sh1.Range("O" & Rows.Count).End(xlUp))
    Set f = rng2.Find(c.Value, , xlValues, xlWhole)
    If Not f Is Nothing Then
      cell = f.Address
      Do
        f.BorderAround ColorIndex:=0, Weight:=xlThick
        Set f = rng2.FindNext(f)
      Loop While Not f Is Nothing And f.Address <> cell
    End If
  Next
'MsgBox "Fin proceso Hoja2"
'++++++++++++++++ subproceso Cuadro, para hoja 'pista. Ya está en Hoja1
Set hopi = Sheets("pista")
'limpiar pista de colores anteriores
hopi.Range("E2:AX40").Interior.PatternColor = xlNone
For x = 2 To Range("O" & Rows.Count).End(xlUp).Row
    nrop = Range("O" & x)
    For i = 2 To 34              'antes 45 filas
        For j = 5 To 45 Step 5  'col
        If hopi.Cells(i, j) = Val(Left(nrop, 1)) And hopi.Cells(i, j + 1) = Val(Mid(nrop, 2, 1)) And hopi.Cells(i, j + 2) = Val(Mid(nrop, 3, 1)) And hopi.Cells(i, j + 3) = Val(Mid(nrop, 4, 1)) Then
            filx = i: colf = j
            hopi.Range(hopi.Cells(i, j), hopi.Cells(i, j + 3)).Interior.ColorIndex = 6
            Exit For
        End If
        Next j
        If hopi.Cells(i + 1, 5) = "" Then i = i + 2
    Next i
Next x
'MsgBox "Fin proceso 'pista'"
'**************** colorear hoja 'pistadia' según comparación con Hoja1
Application.ScreenUpdating = False
'quitar colores anteriores en hoja pistadia
Sheets("pistadia").Select
[A1].Select
With ActiveSheet.UsedRange.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
'ubica la última celda de la hoja
    ActiveCell.SpecialCells(xlLastCell).Select
    R = ActiveCell.Row
    c = ActiveCell.Column
    For xc = 1 To c
        For xr = 1 To R
            If Len(Cells(xr, xc)) > 0 Then
                Cells(xr, xc).Select
                'buscar en Hoja1 en lugar de Hoja2   'ver tipo de número
                igual = Application.WorksheetFunction.CountIf(Worksheets("Hoja1").Range("O:O"), ActiveCell.Value)
                If igual > 0 Then
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorAccent4
                        .TintAndShade = 0.399975585192419
                        .PatternTintAndShade = 0
                    End With
                End If
            End If
        Next xr
    Next xc
'MsgBox "Fin proceso pistadia"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas