Formula cambia al haber cambios en la hoja (aleatorio)
Formula cambia el haber cambios en la hoja
•Todas las celdas tienen la misma distancia entre boletin y boletin:
Boletin 1
•R9 R13 R17 R21
Boletin 2
•R36 R40 R44 R48
Boletin 3
•R62 R66 R70 R74
Boletin 4
•R89 R93 R97 R101
La macro estaría en un boton por boletín o un solo para todo. Aunque fuera mejor que se autoejecute supongo que podria ser por medio de cambios en la hoja.
Una solución para dejar fijo el valor encontrado es utilizar una macro.
Sub Indicadores()
'Por.Dante Amor
Dim valores As New Collection
Dim letras As New Collection
Set valores = Nothing
Set letras = Nothing
'
Set h = Sheets("Indicadores Soc")
celdas = Array(10, 14, 18, 22)
For i = LBound(celdas) To UBound(celdas)
dato = ""
valor = Range("C" & celdas(i)) + Evaluate("=RANDBETWEEN(0,4)") / 10
valores.Add Range("C" & celdas(i))
Set b = h.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
existe = False
For j = valores.Count - 1 To 1 Step -1
If valores(j) = Range("C" & celdas(i)) Then
existe = True
Exit For
End If
Next
If existe Then dato = letras(j) Else dato = b.Offset(0, 1)
End If
Range("R" & celdas(i)) = dato
letras.Add dato
Next
Set valores = Nothing
Set letras = Nothing
End Sub
1 Respuesta
H o l a:
Al parecer no hay la misma distancia entre boletín y boletín
Del 1 al 2 hay 27 celdas, del 2 al 3 hay 26 celdas. Puedes revisarlo.
Después de que revises la distancia entre boletines, envíame el archivo para adaptar la macro.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Daniel Herrera Flores” y el título de esta pregunta.
Te anexo la macro
Sub Indicadores()
'Por.Dante Amor
Dim valores As New Collection
Dim letras As New Collection
'
Set h = Sheets("Indicadores Soc")
'celdas = Array(10, 14, 18, 22)
Set valores = Nothing
Set letras = Nothing
bimestre = 1
'
For i = 9 To Range("C" & Rows.Count).End(xlUp).Row
If Cells(i, "C") = "NUM" Then
If bimestre = 5 Then
Set valores = Nothing
Set letras = Nothing
bimestre = 1
End If
dato = ""
elnum = Cells(i + 1, "C").Value
valor = elnum + Evaluate("=RANDBETWEEN(0,4)") / 10
valores.Add elnum
Set b = h.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
existe = False
For j = valores.Count - 1 To 1 Step -1
If valores(j) = elnum Then
existe = True
Exit For
End If
Next
If existe Then dato = letras(j) Else dato = b.Offset(0, 1)
End If
Range("R" & i) = dato
letras.Add dato
bimestre = bimestre + 1
End If
Next
Set valores = Nothing
Set letras = Nothing
MsgBox "Fin"
End SubR ecuerda valorar las respuestas.
