Este fórum está sendo desativado

[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

[babdallas]

Veja se a solução ajuda.

[Angrass]

Bom dia
babdallas, muitíssimo obrigado. Ficou show

[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