Modificar libro en excel con condiciones
Para elsa:
Maestra elsa colabore con modificar las macros de la hoja pista, pistadia y hoja 2
Respuesta de Elsa Matilde
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
