none
Filtros através de VBA RRS feed

Respostas

  • Sub Declara()
      Dim lRow As Long
      Dim ws As Excel.Worksheet
      Dim wsDeclaração As Excel.Worksheet
      
      Set wsDeclaração = ThisWorkbook.Worksheets("declaracao")
      
      Set ws = ThisWorkbook.Worksheets("Plan1")
      lRow = pMatch("Jairo Raimundo", ws.Columns("A"))
      If lRow Then
        wsDeclaração.Cells(15, 1) = ws.Cells(lRow, 1)
        wsDeclaração.Cells(16, 3) = ws.Cells(lRow, 2)
        wsDeclaração.Cells(16, 5) = ws.Cells(lRow, 3)
        wsDeclaração.Cells(17, 2) = ws.Cells(lRow, 4)
        wsDeclaração.Cells(18, 2) = ws.Cells(lRow, 5)
      End If
    
      Set ws = ThisWorkbook.Worksheets("Plan2")
      lRow = pMatch("Jairo Raimundo", ws.Columns("A"))
      If lRow Then
        wsDeclaração.Cells(25, 1) = ws.Cells(lRow, 1)
        wsDeclaração.Cells(26, 3) = ws.Cells(lRow, 2)
        wsDeclaração.Cells(26, 5) = ws.Cells(lRow, 3)
        wsDeclaração.Cells(27, 2) = ws.Cells(lRow, 4)
        wsDeclaração.Cells(28, 2) = ws.Cells(lRow, 5)
      End If
    End Sub
    
    Public Function pMatch(vValue As Variant, _
                           vArray As Variant) As Long
      'Retorna a linha/coluna/índice de um valor encontrado numa coluna/linha/vetor.
      'Retorna 0 se elemento não for encontrado.
      Dim ret As Long
    
      On Error Resume Next
      ret = WorksheetFunction.Match(CDbl(vValue), vArray, 0)
      If ret = 0 Then ret = WorksheetFunction.Match(CStr(vValue), vArray, 0)
      On Error GoTo 0
    
      pMatch = ret
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 5 de fevereiro de 2015 12:53
    Moderador

Todas as Respostas

  • Poderia postar o código gerado aqui para sugerirmos uma solução?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 4 de fevereiro de 2015 11:49
    Moderador
  • Sub Declara()
    Lin = 2
    Linha = 2
    Do Until Sheets("Plan1").Cells(Lin, 1) = ""
        If Sheets("Plan1").Cells(Lin, 1) = "Jairo Raimundo" Then
           Sheets("declaracao").Cells(15, 1) = Sheets("Plan1").Cells(Lin, 1)
            Sheets("declaracao").Cells(16, 3) = Sheets("Plan1").Cells(Lin, 2)
            Sheets("declaracao").Cells(16, 5) = Sheets("Plan1").Cells(Lin, 3)
            Sheets("declaracao").Cells(17, 2) = Sheets("Plan1").Cells(Lin, 4)
            Sheets("declaracao").Cells(18, 2) = Sheets("Plan1").Cells(Lin, 5)

        End If
        Lin = Lin + 1
    Loop
    End Sub

    Esta macro procura o nome "Jairo Raimundo" na plan1, quando acha o nome ela copia os dados da linha para a planilha "declaracao"

    Eu queria pesquisar o mesmo critério "Jairo Raimundo" em outra planilha (plan2) e copiar para outras células da planilha "declaracao". De modo que o critério "Jairo Raimundo" ao ser encontrado nas duas planilha copie os dados das mesmas.

                   
    quinta-feira, 5 de fevereiro de 2015 01:48
  • Sub Declara()
      Dim lRow As Long
      Dim ws As Excel.Worksheet
      Dim wsDeclaração As Excel.Worksheet
      
      Set wsDeclaração = ThisWorkbook.Worksheets("declaracao")
      
      Set ws = ThisWorkbook.Worksheets("Plan1")
      lRow = pMatch("Jairo Raimundo", ws.Columns("A"))
      If lRow Then
        wsDeclaração.Cells(15, 1) = ws.Cells(lRow, 1)
        wsDeclaração.Cells(16, 3) = ws.Cells(lRow, 2)
        wsDeclaração.Cells(16, 5) = ws.Cells(lRow, 3)
        wsDeclaração.Cells(17, 2) = ws.Cells(lRow, 4)
        wsDeclaração.Cells(18, 2) = ws.Cells(lRow, 5)
      End If
    
      Set ws = ThisWorkbook.Worksheets("Plan2")
      lRow = pMatch("Jairo Raimundo", ws.Columns("A"))
      If lRow Then
        wsDeclaração.Cells(25, 1) = ws.Cells(lRow, 1)
        wsDeclaração.Cells(26, 3) = ws.Cells(lRow, 2)
        wsDeclaração.Cells(26, 5) = ws.Cells(lRow, 3)
        wsDeclaração.Cells(27, 2) = ws.Cells(lRow, 4)
        wsDeclaração.Cells(28, 2) = ws.Cells(lRow, 5)
      End If
    End Sub
    
    Public Function pMatch(vValue As Variant, _
                           vArray As Variant) As Long
      'Retorna a linha/coluna/índice de um valor encontrado numa coluna/linha/vetor.
      'Retorna 0 se elemento não for encontrado.
      Dim ret As Long
    
      On Error Resume Next
      ret = WorksheetFunction.Match(CDbl(vValue), vArray, 0)
      If ret = 0 Then ret = WorksheetFunction.Match(CStr(vValue), vArray, 0)
      On Error GoTo 0
    
      pMatch = ret
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 5 de fevereiro de 2015 12:53
    Moderador
  • Valeu Felipe, vou tentar criar minha macro com os dados que vc me enviou.
    sexta-feira, 6 de fevereiro de 2015 22:50
  • Consegui adaptar a macro 
    sábado, 7 de fevereiro de 2015 02:56