[Resolvido] Listas que interagem

[Pennafortt]

Boa noite

Tenho duas listas distintas: A4:C13 e H4:J13, e duas colunas de marcação: E4:E13 e F4:F13. Marcando-se um X na coluna E4, são pintados os números 21-35-40, bem como números iguais a eles em qualquer parte da lista 1 e 2. Uma vez que esses numeros tenham sidos marcados (21, 35, 40) eles ficam inoperantes ao longo das listas. Os numeros parceiros a eles, que estão na mesma linha e que ainda não foram marcados, permanecem em condições de receber um “x”. Exemplo: lista1 – linhas 6, 9, 12 e lista2 – linhas 4, 7, 11 e 13. Esse procedimento é igual em qualquer parte da lista, visto que serão marcados vários “x” ao longo das listas 1 e 2. Haverá muitos casos em que números já marcados estarão em combinação com números diferentes deles. Em outra marcação, dessa vez na lista2, F11 é marcado (39,33) é colorido em diferentes partes da lista, observando que o 21 (I11) e 40 (B9) permanecem neutros porque já haviam sido marcados. Ao longo das listas, haverá casos em que linhas com apenas um numero inédito pode receber um “x”. Se for preciso deletar um “x”, a linha volta ao original e fica em condições de receber marcação futura. A planilha completa tem mais de 1000 linhas e cinco colunas.

Edited June 21, 2012 at 06:10 PM by Pennafortt

[acao]

boas

amigo amostre o que já fez,

você não colocou a dúvida. apenas colocou o que pretende fazer.

mas se ainda não fez nada deverá utilizar macros ou vba (cod).

cumps

acao

[Pennafortt]

Boa Noite

Queria me desculpar por postar o link errado.

São duas listas distintas: A4:E50 e J4:N50, e duas colunas de marcação: G4 e H4. Marcando-se um X na coluna G4, são pintados os números 21-35-40-33-27, bem como números iguais a eles em qualquer parte da lista 1 e 2. Uma vez que esses números tenham sidos marcados (21-35-40-33-27) eles ficam inoperantes ao longo das listas. Os números parceiros a eles, que estão na mesma linha e que ainda não foram marcados, permanecem em condições de receber um “x. Esse procedimento é igual em qualquer parte da lista, visto que serão marcados vários “x” ao longo das listas 1 e 2. Haverá muitos casos em que números já marcados estarão em combinação com números diferentes deles. Ao longo das listas, haverá casos em que linhas com apenas um ou dois números inédito pode receber um “x”. Se for preciso deletar um “x”, a linha volta ao original e fica em condições de receber marcação futura.

O código abaixo é de autoria de Felipe Costa Gualberto (meus agradecimentos) o qual peço permissão para postar. Apesar da dedicação em solucionar o problema, o código ainda não cumpriu com seu objetivo, mas chegou muito perto.

https://skydrive.liv... ... 0E0661!400

Obrigado

Edited June 21, 2012 at 06:48 PM by Pennafortt

[acao]

boas

amigo você colocou um ficheiro e não o código.

e já agora isto cheira-me a numeros de euromilhões ou outro, especifique o retorno que quer que o programa faça, poderá haver solução diferente.

cumps

acao

[Pennafortt]

Boas

Option Explicit

Sub Exemplo()

End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("G:H")) Is Nothing Then Exit Sub

Dim rng(1 To 2) As Range

Dim lRng As Long

Dim rRow As Range

Dim lCol As Long

Dim lColAjuste As Long

Dim lInício As Long

Application.EnableEvents = False

If Target.Column = Columns("G").Column Then lInício = 1 Else lInício = 10

Set rng(1) = Range("A4:E50")

Set rng(2) = Range("J4:N50")

For lCol = lInício To lInício + 4

For lRng = LBound(rng) To UBound(rng)

For Each rRow In rng(lRng).Rows

If WorksheetFunction.CountIf(rRow, Cells(Target.Row, lCol)) > 0 Then

If lRng = 1 Then lColAjuste = 0 Else lColAjuste = 9

Cells(rRow.Row, lCol + lColAjuste - lInício + 1).Interior.Color = RGB(255, 127, 127)

End If

Next rRow

Next lRng

Next lCol

Application.EnableEvents = True

End Sub

[acao]

Boa Noite

Queria me desculpar por postar o link errado.

São duas listas distintas: A4:E50 e J4:N50, e duas colunas de marcação: G4 e H4. Marcando-se um X na coluna G4, são pintados os números 21-35-40-33-27, bem como números iguais a eles em qualquer parte da lista 1 e 2. Uma vez que esses números tenham sidos marcados (21-35-40-33-27) eles ficam inoperantes ao longo das listas. Os números parceiros a eles, que estão na mesma linha e que ainda não foram marcados, permanecem em condições de receber um “x. Esse procedimento é igual em qualquer parte da lista, visto que serão marcados vários “x” ao longo das listas 1 e 2. Haverá muitos casos em que números já marcados estarão em combinação com números diferentes deles. Ao longo das listas, haverá casos em que linhas com apenas um ou dois números inédito pode receber um “x”. Se for preciso deletar um “x”, a linha volta ao original e fica em condições de receber marcação futura.

O código abaixo é de autoria de Felipe Costa Gualberto (meus agradecimentos) o qual peço permissão para postar. Apesar da dedicação em solucionar o problema, o código ainda não cumpriu com seu objetivo, mas chegou muito perto.

https://skydrive.liv... ... 0E0661!400

Obrigado

boas

amigo penafortt estive a testar o cod que você colocou e não faz nada daquilo ue você pretende por isso informe o seguinte:

1- tem que colocar um x na celula da coluna G ou H ou não ?.

2- ao marca os numeros A4:E4, quando encontrar um numero destes noutra linha, pinta a linha toda entre a coluna AeE ou apenas a celula do numero igual ?.

3- o que significa isto para você «(21-35-40-33-27) eles ficam inoperantes ao longo das listas».?.

4- a cor é a mesma para todos os numeros ou varia conforme a linha?.

cumps

acao

[Pennafortt]

Boas

Pois bem:

1- tem que colocar um x na celula da coluna G ou H ou não ?.

Pode ser em uma ou nas duas ao mesmo tempo as listas interagem, se relacionam

2- ao marca os numeros A4:E4, quando encontrar um numero destes noutra linha, pinta a linha toda entre a coluna AeE ou apenas a celula do numero igual ?.

Apenas células com números iguais ou seja se foi marcado antes então tá pintado e não precisa marcar mais

3- o que significa isto para você «(21-35-40-33-27) eles ficam inoperantes ao longo das listas».?.

Essa sequencia foi usada como exemplo, assim como podia ser qualquer outra.

4- a cor é a mesma para todos os numeros ou varia conforme a linha?.

A cor é igual para qualquer linha ou célula marcada

cumps

Edited June 23, 2012 at 12:18 AM by Pennafortt

[acao]

boas

amigo Pennafortt a minha solução é:

1- Fazer uma pesquisa à celula selecionada e passar o valor para uma variavel. pode ser assim «variavel = Target.Value»

2- alterar a variavel array para 10 elementos, sendo um elemento para cada coluna (A,B,C,D,E,J,K,L,M,N) assim «Dim rng(1 To 10) As Range» e depois atribuir-lhe os valores

3- fazer um contador de colunas com uma variavel e coloca-la dentro do «For lRng» assim, variavel = variavel + 1 e dar-lhe o valor «0» assim variavel = 0 no «For lCol»

4. alterar este if « If lRng = 1 Then lColAjuste = 0 Else lColAjuste = 9 » para:

If lRng >= 1 And lRng <= 5 Then lColAjuste = 0 Else lColAjuste = 4

5- e o codigo a seguir controlá-lo com o valor da variavel referente ao nº1, se o valor é <> empty, ou se pretender, se o valor = X faz cod:

Cells(rRow.Row, «aqui variavel referente ao nº 3» + lColAjuste).Interior.Color = RGB(255, 127, 127)

se não «else»

Cells(rRow.Row, «aqui variavel referente ao nº 3» + lColAjuste).Interior.ColorIndex = 0

5- limpar os valores da coluna G e H.

cumps

acao

[Pennafortt]

Boas

Acao vou implementar suas sugestões e resolver o problema, obrigado pela ajuda

cumps

[acao]

boas

se for muito dificil ou não conseguir dê um grito.

que nós aparecemos.

cumps

acao

[Pennafortt]

Boas

Acao, infelizmente não consegui fazer funcionar o codigo. Agradeceria se pudesse fazer as alterações de modo que se pudesse usar

cumps

[acao]

boas

está aqui o codigo todo com as minhas alterações.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("G:H")) Is Nothing Then Exit Sub

Dim rng(1 To 10) As Range
Dim lRng As Long
Dim rRow As Range
Dim lCol As Long
Dim lColAjuste As Long
Dim lInício As Long
Dim vContCul As Byte
Dim vValorCel As String
Application.EnableEvents = False
vValorCel = Target.Value

If Target.Column = Columns("G").Column Then lInício = 1 Else lInício = 10

Set rng(1) = Range("A4:A50")
Set rng(2) = Range("B4:B50")
Set rng(3) = Range("C4:C50")
Set rng(4) = Range("D4:D50")
Set rng(5) = Range("E4:E50")
Set rng(6) = Range("J4:J50")
Set rng(7) = Range("K4:K50")
Set rng(8) = Range("L4:L50")
Set rng(9) = Range("M4:M50")
Set rng(10) = Range("N4:N50")

For lCol = lInício To lInício + 4
vContCul = 0
For lRng = LBound(rng) To UBound(rng)
vContCul = vContCul + 1
For Each rRow In rng(lRng).Rows
If WorksheetFunction.CountIf(rRow, Cells(Target.Row, lCol)) > 0 Then
If lRng >= 1 And lRng <= 5 Then lColAjuste = 0 Else lColAjuste = 4
If vValorCel <> Empty Then
Cells(rRow.Row, vContCul + lColAjuste).Interior.Color = RGB(255, 127, 127)
Else
Cells(rRow.Row, vContCul + lColAjuste).Interior.ColorIndex = 0
End If
End If
Next rRow
Next lRng
Next lCol
Range("G4:H50").Value = ""

Application.EnableEvents = True

End Sub

cumps

acao

[Pennafortt]

Boas

Acao, fico a dever-te uma. Já consegui adaptar ao ficheiro que queria.

mais uma vez obrigado