Jump to content

[Resolvido] Listas que interagem


Recommended Posts

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 by Pennafortt
Link to comment
Share on other sites

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 by Pennafortt
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by Pennafortt
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.