Página 1 de 1

Formatar blocos de numeros

Enviado: 19 Abr 2022 às 11:07
por Angrass
Bom dia
Em uma lista de vários números, preciso dividir em blocos o total de números e formatar de modo que fiquem mais ou menos com a mesma quantidade de números :D :D

Re: Formatar blocos de numeros

Enviado: 19 Abr 2022 às 23:52
por babdallas
Veja se a solução ajuda.

Re: Formatar blocos de numeros

Enviado: 20 Abr 2022 às 10:05
por Angrass
Bom dia
babdallas, muitíssimo obrigado. Ficou show :D :D

Re: Formatar blocos de numeros

Enviado: 20 Abr 2022 às 10:43
por osvaldomp
Segue alternativa via macro.
Sem limites de números, de blocos, sem células auxiliares.
Código: Selecionar todos
Sub AngraESeusQuebraCabeças()
 Dim b As Long, m As Long, v As Long, y As Long, k As Long, x As Boolean
  Range("G10", Range("G10").End(xlToRight)).Interior.Color = xlNone
  If [E10] Mod [E8] = 0 Then
   For b = 1 To [E8]
    Cells(10, m + 7).Resize(, [E10] / [E8]).Interior.Color = IIf(x, vbYellow, vbGreen)
    m = m + [E10] / [E8]: x = Not x
   Next b
  ElseIf ([E10] - Application.RoundUp([E10] / [E8], 0)) Mod ([E8] - 1) = 0 Then
   Cells(10, m + 7).Resize(, Application.RoundUp([E10] / [E8], 0)).Interior.Color = IIf(x, vbYellow, vbGreen)
   m = m + Application.RoundUp([E10] / [E8], 0): x = Not x
   For b = 1 To [E8] - 1
    Cells(10, m + 7).Resize(, ([E10] - Application.RoundUp([E10] / [E8], 0)) / ([E8] - 1)).Interior.Color = IIf(x, vbYellow, vbGreen)
    m = m + ([E10] - Application.RoundUp([E10] / [E8], 0)) / ([E8] - 1): x = Not x
   Next b
  ElseIf ([E10] - Application.RoundDown([E10] / [E8], 0)) Mod ([E8] - 1) = 0 Then
   Cells(10, m + 7).Resize(, Application.RoundDown([E10] / [E8], 0)).Interior.Color = IIf(x, vbYellow, vbGreen)
   m = m + Application.RoundDown([E10] / [E8], 0): x = Not x
   For b = 1 To [E8] - 1
    Cells(10, m + 7).Resize(, ([E10] - Application.RoundDown([E10] / [E8], 0)) / ([E8] - 1)).Interior.Color = IIf(x, vbYellow, vbGreen)
    m = m + ([E10] - Application.RoundDown([E10] / [E8], 0)) / ([E8] - 1): x = Not x
   Next b
  Else: For b = 1 To [E8] - 1
   k = IIf(x, Application.RoundUp([E10] / [E8], 0), Application.RoundDown([E10] / [E8], 0))
   Cells(10, m + 7).Resize(, k).Interior.Color = IIf(x, vbYellow, vbGreen)
   m = m + k: x = Not x
  Next b
  Cells(10, m + 7).Resize(, [E10] - m).Interior.Color = IIf(x, vbYellow, vbGreen)
  End If
End Sub