Este fórum está sendo desativado

[JCabral]

Boa noite

Mais uma vez pedindo ajuda para encontrar o melhor código/VBA para um problema que tenho, assim:
1) Tenho na aba "Data" uma série de códigos, neste caso no range ("E2:E13"), começa sempre em E2 mas o número de códigos é variável;

2) Pretendo que para cada código na Aba "Data" que seja igual ao código na Tabela "tblBACKUP" da aba Backup coluna "idCodAtv" o valor na coluna "inFTE" da Tabela "tblBACKUP" passe para "VERDADEIRO"

Obrigado pela ajuda
Jorge Cabral

[gfranco]

Boa noite.
Veja se te atende.

[gfranco]

PS: resolvi com fórmula por entender ser o método mais simples para o caso apresentado.
Se for imperioso o uso de VBA, favor avisar.

[JCabral]

Boa noite gfranco

Atendendo ao resto do processo, isto é uma pequena parte, é de facto imperioso o uso do VBA.

Muito obrigado pela ajuda.
Jorge Cabral

[gfranco]

Atendendo ao resto do processo, isto é uma pequena parte, é de facto imperioso o uso do VBA.

Veja se te atende agora.

[gfranco]

Uma versão mais "enxuta" e que produz o mesmo resultado, teste-a no mesmo arquivo que postei acima:

Código: Selecionar todos

Sub preenche2()
On Error GoTo errPreenche
Dim tbPrincipal As ListObject, tbBusca As ListObject
Dim counter As Long, i As Long
Dim wkf As WorksheetFunction
Dim colBusca As Long, colResultado As Long
Dim resultado As Boolean
Dim procurado As Variant


Set tbPrincipal = Backup.ListObjects("tblBACKUP")
Set tbBusca = Data.ListObjects("TbCodigos")
Set wkf = Application.WorksheetFunction


colBusca = wkf.Match("idCodAtv", tbPrincipal.HeaderRowRange, 0)
colResultado = wkf.Match("inFTE", tbPrincipal.HeaderRowRange, 0)

tbPrincipal.ListColumns(colResultado).DataBodyRange.ClearContents

    For i = 1 To tbPrincipal.DataBodyRange.Rows.Count
        resultado = False
        procurado = tbPrincipal.DataBodyRange.Cells(i, colBusca)
        counter = wkf.CountIf(tbBusca.ListColumns(1).DataBodyRange, procurado)
        
        If counter > 0 Then resultado = True
        
        tbPrincipal.DataBodyRange.Cells(i, colResultado) = resultado
    
    
    Next i


Exit Sub

errPreenche:

MsgBox "Um erro ocorreu, verifique !", vbExclamation, "Atenção"


End Sub

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub InsereVerdadeiro()
 Dim idCodAtv As Range, k As Long
  With Sheets("Data")
   For Each idCodAtv In .Range("E2:E" & .Cells(Rows.Count, 5).End(3).Row)
    If Application.CountIf(Sheets("Backup").[A:A], idCodAtv.Value) > 0 Then
     k = Sheets("Backup").[A:A].Find(idCodAtv.Value, lookat:=xlWhole).Row
     Sheets("Backup").Cells(k, "P") = True
    End If
   Next idCodAtv
  End With
End Sub

ou

Código: Selecionar todos

Sub InsereVerdadeiroV2()
 Dim idCodAtv As Range
  With Sheets("Backup")
   For Each idCodAtv In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row)
    If Application.CountIf(Sheets("Data").[E:E], idCodAtv.Value) > 0 Then idCodAtv.Offset(, 15).Value = True
   Next idCodAtv
  End With
End Sub

[JCabral]

gfranco e osvaldomp, muito obrigado pelas vossas versões ambas funcionam impecavelmente, irei colocar um novo post e que passa por ler para uma listbox apenas os valor (todas as colunas) com VERDADEIRO.

Mais uma vez muito obrigado
Jorge Cabral