Notifications
Clear all

Buscar numeros em grupos

3 Posts
2 Usuários
0 Reactions
855 Visualizações
(@maguiver)
Posts: 11
Active Member
Topic starter
 

Ola Pessoal, vejam se podem me ajudar com uma macro

A1 = 01-03-05-07-09 <- aqui uma linha de numeros

grupo 1 = 02 06 08
grupo 2 = 01 04 10
grupo 3 = 03 05 11
grupo 4 = 07 09 12

A5 = grupo2 grupo3 grupo4 <- aqui a linha de numeros convertidos para grupos, ou seja os numeros de A1 estao nesses grupos
esses grupos nao serao fixos, e a linha de numeros A1 possivelmente ira ate A20000, e precisava converter cada uma dessas linhas
nos grupos
no caso eu estou convertendo a linha A1, na linha A5

desde ja agradeço a quem puder ajudar
grato
Maguiver

 
Postado : 07/04/2016 2:02 pm
(@maguiver)
Posts: 11
Active Member
Topic starter
 

Bom pessoal, consegui parcialmente usando a rotina abaixo que adaptei com meu pouco conhecimento em VBA, mas me deparei com 2 problemas
1- a rotina só esta fazendo a conversao de uma linha de resultados somente, e preciso que ela corra todas as linhas e apresente os grupos
2- quando faz a conversao esta trazendo 2 ou mais vezes o mesmo grupo(isso acontece pois havera grupos com mais de uma dezena no resultado) e pra mim nao importa a quantidade de dezenas, era só colocar que aquele grupo teve dezenas sorteadas.
se alguem puder ajudar,
grato

Sub Converter()
Dim CompareRange As Variant, x As Variant, y As Variant
Dim k As Integer, j As Integer

k = 8 'Linha Inicial
j = 25 'coluna inicial

Range("y8:am27").ClearContents
Set CompareRange = Range("c2:v2")
For Each x In Range("c5:g5")
For Each y In CompareRange
If x = y Then Cells(k, j) = 1
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c6:g6")
For Each y In CompareRange
If x = y Then Cells(k, j) = 2
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c7:g7")
For Each y In CompareRange
If x = y Then Cells(k, j) = 3
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c8:g8")
For Each y In CompareRange
If x = y Then Cells(k, j) = 4
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c9:g9")
For Each y In CompareRange
If x = y Then Cells(k, j) = 5
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c11:g11")
For Each y In CompareRange
If x = y Then Cells(k, j) = 6
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c12:g12")
For Each y In CompareRange
If x = y Then Cells(k, j) = 7
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c13:g13")
For Each y In CompareRange
If x = y Then Cells(k, j) = 8
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c14:g14")
For Each y In CompareRange
If x = y Then Cells(k, j) = 9
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c15:g15")
For Each y In CompareRange
If x = y Then Cells(k, j) = 10
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c17:g17")
For Each y In CompareRange
If x = y Then Cells(k, j) = 11
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x

For Each x In Range("c18:g18")
For Each y In CompareRange
If x = y Then Cells(k, j) = 12
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c19:g19")
For Each y In CompareRange
If x = y Then Cells(k, j) = 13
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c20:g20")
For Each y In CompareRange
If x = y Then Cells(k, j) = 14
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c21:g21")
For Each y In CompareRange
If x = y Then Cells(k, j) = 15
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c23:g23")
For Each y In CompareRange
If x = y Then Cells(k, j) = 16
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c24:g24")
For Each y In CompareRange
If x = y Then Cells(k, j) = 17
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c25:g25")
For Each y In CompareRange
If x = y Then Cells(k, j) = 18
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c26:g26")
For Each y In CompareRange
If x = y Then Cells(k, j) = 19
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
For Each x In Range("c27:g27")
For Each y In CompareRange
If x = y Then Cells(k, j) = 20
Next y
j = j + 1
If j = 19 Then
j = 14
k = k + 1
End If
Next x
MsgBox "Grupos Convertidos"
End Sub

 
Postado : 08/04/2016 10:10 am
edilsonfl
(@edilsonfl)
Posts: 227
Estimable Member
 

Tá um pouco complicado entender o que vc deseja.
Poste um modelo de sua planilha ( arquivo zipado, conforme regras do forum) demonstrando o resultado esperado.

Quando ajuda for útil dê um clique na mãozinha, isso atribui ponto ao colaborador.

 
Postado : 08/04/2016 9:01 pm