Este fórum está sendo desativado

[CarlinhosW]

Bom dia a todos, estou tento um problema. Essa planilha em anexo é para eu localizar itens no meu estoque que estao dentro de caixas, só que alguns dos itens estão em mais de uma caixas, alguns itens tem 10 a 15 caixas, não estou acertando o macro para conseguir fazer a pesquisa. O que eu queria é quando eu insiro o código ou lote ou a caixa é que ele puxe todos relacionados. Ex: procurei por Caixa; CX01 ai quero que me mostre todos os itens que estão em na CX01.
Conseguem me ajudar ?

[osvaldomp]

Experimente:

Código: Selecionar todos

Sub Multipla_Pesquisa()
 Dim aCell As Range, oq As String, x As Long, ws2 As Worksheet, bCell As String
  
  Set ws2 = Sheets("Cadastro de Local")

  If ActiveSheet.TextBox1.Text <> "" Then
   x = 1: oq = ActiveSheet.TextBox1.Text
  ElseIf ActiveSheet.TextBox2.Text <> "" Then
   x = 2: oq = ActiveSheet.TextBox2.Text
  ElseIf ActiveSheet.TextBox3.Text <> "" Then
   x = 3: oq = ActiveSheet.TextBox3.Text
  Else: MsgBox "Por favor Insira informação para pesquisa", 64, "Atenção": Exit Sub
  End If
  
  Range("B10:E40").ClearContents ' Limpa os dados do intervalo

    With ws2
     Set aCell = .Columns(x).Find(What:=oq)
      If Not aCell Is Nothing Then
       bCell = aCell.Address
        Do
         Cells(Rows.Count, 2).End(3)(2).Resize(, 4).Value = .Cells(aCell.Row, 1).Resize(, 4).Value
          Set aCell = .Columns(x).FindNext(After:=aCell)
        Loop While aCell.Address <> bCell
      Else
       MsgBox "Dados não localizados !", 64, "Aviso"
      End If
    End With
    
End Sub

[CarlinhosW]

Experimente:

Código: Selecionar todos

Sub Multipla_Pesquisa()
 Dim aCell As Range, oq As String, x As Long, ws2 As Worksheet, bCell As String
  
  Set ws2 = Sheets("Cadastro de Local")

  If ActiveSheet.TextBox1.Text <> "" Then
   x = 1: oq = ActiveSheet.TextBox1.Text
  ElseIf ActiveSheet.TextBox2.Text <> "" Then
   x = 2: oq = ActiveSheet.TextBox2.Text
  ElseIf ActiveSheet.TextBox3.Text <> "" Then
   x = 3: oq = ActiveSheet.TextBox3.Text
  Else: MsgBox "Por favor Insira informação para pesquisa", 64, "Atenção": Exit Sub
  End If
  
  Range("B10:E40").ClearContents ' Limpa os dados do intervalo

    With ws2
     Set aCell = .Columns(x).Find(What:=oq)
      If Not aCell Is Nothing Then
       bCell = aCell.Address
        Do
         Cells(Rows.Count, 2).End(3)(2).Resize(, 4).Value = .Cells(aCell.Row, 1).Resize(, 4).Value
          Set aCell = .Columns(x).FindNext(After:=aCell)
        Loop While aCell.Address <> bCell
      Else
       MsgBox "Dados não localizados !", 64, "Aviso"
      End If
    End With
    
End Sub

Obrigado osvaldomp, era isso mesmo que eu precisava, você pode me dizer como fez ? pois comecei a mexer com esse tipo de excel mais avanço recentemente. Muito obrigado mesmo

[osvaldomp]

1. cole os dois códigos lado a lado na planilha ou em um editor de texto e compare linha por linha para ver as principais diferenças.

2. ajuste a posição e o tamanho da janela do Editor de VBA sobre a planilha de forma que você consiga visualizar as ações na planilha durante a execução dos dois códigos via F8.

Retorne se restar alguma dúvida pontual.