excel vba: copiar linhas se os dados corresponderem aos valores na coluna em outra folha

Question

Eu fiz uma pergunta relacionada aqui .
Sir Adelaide forneceu-me esta solução muito útil.

Agora, neste caso quase semelhante, tenho duas planilhas do excel em minha pasta de trabalho.
[Xsheet] [1] Folha1

Vou percorrer o nome e a coluna de descrição na Folha1 para ver se ela corresponde à coluna de descrição do valor ou no XSheet (pode haver linhas de dados infinitas na coluna). Em caso afirmativo, a linha 'that' na Sheet1 seria copiada para a nova Sheet2.

Eu modifiquei um pouco na codificação anterior (fornecida por Sir Adelaide),

Sub Procedure2()

Dim xsht As Worksheet
Dim sht As Worksheet 'original sheet
Dim newsht As Worksheet 'sheet with new data

Set xsht = ThisWorkbook.Worksheets("Xsheet")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

'Set dat = sht.Range("code").Cells(1,1)
Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
i = 1
j = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While dat.Offset(i, 0).Value <> "" 'loop row till code data goes blank
  If ((main.Offset(i, 0).Value = dat.Offset(i, 4).Value Or _
  main.Offset(i, 1).Value = dat.Offset(i, 5).Value) And dat.Offset(i, 6).Value = "active") Then 'check conditions
    newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code
    newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title
    newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date
    newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name
    newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr
    newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status
    j = j + 1
  End If

  i = i + 1
Loop

Qualquer conselho fornecido seria apreciado. Obrigado.
saída Oi, tentei executar o código atualizado.
Esta é minha saída, mas há um caso inativo, que não está correto.
A saída correta deve ser 4566,4987,4988. Eu passei pelo código, Idk o que deu errado

Eu tiro o Xsheet link porque não tenho reputação suficiente para fazer mais do que 2 hiperlinks

Eu agora percorro a Sheet1 para ver se ela corresponde às colunas no Xsheet.
4566, corresponde a 'Adam' no nome col (já que é nome ou descrição, então se o nome corresponde, então é uma correspondência), e (precisa ser) ativo, portanto, é. 4899, Edward é um jogo (ou qualquer descrição), mas não corresponde a e ativo, portanto não.
4987, mesmo caso como 4566, seu Adão e ativo.
4988, Kris (não é um nome de correspondência), mas está na descrição do Xsheet, e ativo, então está em. 4989, Chris não é um nome de jogo, ttr não é uma descrição de correspondência, mesmo sendo um caso ativo (eu também não aceito)

Obrigado pela sua orientação até agora. Eu realmente aprecio isso.

    

Answer 1

Então, depois de descobrir o que você está realmente fazendo. A questão é simples:

"Se o Nome ou a Descrição na Lista Mestra for encontrado na Folha de Dados e também for Ativo, copie-o para uma nova planilha".

Operadores lógicos: ordem de precedência

Aqui está uma revisão do código do seu comentário recente.

Sub Procedure2()

Dim xsht As Worksheet
Dim sht As Worksheet 'original sheet
Dim newsht As Worksheet 'sheet with new data

Set xsht = ThisWorkbook.Worksheets("Xsheet")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

'Set dat = sht.Range("code").Cells(1,1)
Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
Dim i, j, iRow As Integer   'instantiate and initialize the integers
i = 1
j = 1
iRow = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While main.Offset(i, 0).Value <> "" Or main.Offset(i, 1).Value <> ""

  j = 1     'reset DataSheet pointer

  Do While dat.Offset(j, 0).Value <> ""

    If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _
    Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
    And dat.Offset(j, 6).Value = "active" Then

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 'copy code
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 'copy title
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 'copy date
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 'copy name
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 'copy descr
      newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 'copy status
      iRow = iRow + 1
    End If
    j = j + 1     'increment DataSheet pointer; fast moving; changing/resetting
  Loop

  i = i + 1     'increment XSheet pointer; slow moving outer loop; not resetting
Loop
End Sub

Este código revisado tem QUATRO alterações . Adicionada a verificação no OUTER Loop para incluir espaços em branco no campo Nome, adicionando Or main.Offset(i, 1).Value <> "" . A alteração de onde as informações estavam sendo avaliadas de i-para-i_valor, para i-to-j_value, na instrução If . A adição de um terceiro contador para colocação de dados na nova planilha para dados copiados para Sheet2. E por fim, um loop aninhado (loop dentro de um loop). Loop-Outer: olha para a lista principal (xSheet) linha por linha; nunca se repete. Loop-Inner: olha para a folha de dados para comparar de cima para baixo; repete cada nova linha na Lista Mestra.

Você pode até alterar a instrução If para considerar "ativo" vs. "Ativo" ou "A" ou "a". É aqui que uma lista suspensa é útil, mas esse é outro problema em si.

If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _
Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
And (dat.Offset(j, 6).Value = "active" Or dat.Offset(j, 6).Value = "Active") Then