Zoekveld in excel

[martindeboer1988]

Beste leden,

Op dit forum vond ik toevallig een bestandje met zoekveld wat ik ook graag zou willen invoegen in mijn sheet.
Alleen krijg ik het niet voor elkaar zoals ik het wil kan iemand voor mij verduidelijken waar ik de fout in ga?
Ik heb in Sheet1 een lijst met waardes waarvan ik in Sheet2 waar het zoekveld staat de resultaten wil zien.

Private Sub TextBox1_Change()
rij = 8
If TextBox1 = "" Then Sheets(2).Range("C7:E12").ClearContents
If Len(TextBox1) > 3 Then
For Each sh In ThisWorkbook.Sheets
  If sh.Name <> "Sheet1" And sh.Name <> "Sheet2" Then
    With sh.Cells
     Set c = .Cells.Find(TextBox1.Value)
      If Not c Is Nothing Then
        Sheets(2).Cells(rij, 4) = c
        Sheets(2).Cells(rij, 5) = c.Offset(, -5)
        Sheets(2).Cells(rij, 6) = c.Offset(, -3)
        c = "": rij = rij + 1
      End If
   End With
End If
Next
End If
End Sub

 

[gast0660]

Post eens een vbtje van uw bestandje met wat dummy gegevens erin, dan wordt je zo geholpen.

 

[HSV]

Misschien.

Het gezochte zal minimaal in kolom 6 moeten staan anders kan je geen c.offset(,-5) kunnen doen.

With sh
     Set c = [COLOR=#0000ff].columns(6)[/COLOR].Find(TextBox1.Value)
      If Not c Is Nothing Then
        Sheets(2).Cells(rij, 4).resize(,3) = array(c,c.Offset(, -5), c.Offset(, -3))
        c = ""
       rij = rij + 1
      End If
 end with

 

[martindeboer1988]

Voorbeeldje

Bekijk bijlage TMB check.xlsm

Heb het inmiddels zover dat die 1 resultaat laat zien in sheet2 maar ik zou graag willen dat die meerdere mogelijke matches laat zien.
Alvast bedankt

 

[HSV]

Zoiets?

Private Sub TextBox1_Change()
rij = 8
If TextBox1 = "" Then Sheets(2).Range("H8:K12").ClearContents
If Len(TextBox1) > 3 Then
    With Sheets("Sheet1").Columns(5)
    Set c = .Find(TextBox1.Value)
    If Not c Is Nothing Then
      firstaddress = c.Address
     Do
         Sheets(2).Cells(rij, 8) = c
         rij = rij + 1
         Set c = .FindNext(c)
       Loop While Not c Is Nothing And c.Address <> firstaddress
      End If
   End With
End If
End Sub

 

[martindeboer1988]

Daar krijg ik inderdaad meerdere resultaten maar hoe kan ik het nou zo maken dat hoe meer tekens ik typ alleen nog een exacte match over blijft ?

 

[HSV]

De range iedere keer leeg maken zodat het er opnieuw weer in komt.

 

[martindeboer1988]

Misschien een domme vraag maar dat gaat via vba ? Zo ja, hoe dan ?

 

[HSV]

Verwijder het blauwe gedeelte.

[COLOR=#0000ff]If TextBox1 = "" Then [/COLOR]Sheets(2).Range("H8:K12").ClearContents

 

[martindeboer1988]

Top dank je wel

 

[martindeboer1988]

Toch nog even een vraagje ik wil dat de waardes van Sheet1 zowel van kolom 5 als 6 worden weergegeven is dit mogelijk?

Private Sub TextBox1_Change()
rij = 11
Sheets(2).Range("H8:K9999").ClearContents
If Len(TextBox1) > 1 Then
    With Sheets("Sheet1").Columns(5)
    Set c = .Find(TextBox1.Value)
    If Not c Is Nothing Then
      firstaddress = c.Address
     Do
         Sheets(2).Cells(rij, 8) = c
         rij = rij + 1
         Set c = .FindNext(c)
       Loop While Not c Is Nothing And c.Address <> firstaddress
      End If
   End With
End If
End Sub

 

[HSV]

Zoiets bedoel je?

Sheets(2).Cells(rij, 8)[COLOR=#0000ff].resize(,2) = array(c.offset(,-1),c)[/COLOR]

 

[martindeboer1988]

Niet helemaal het gaat me om dit stukje

With Sheets("Sheet1").Columns(5)

Maar dan moet die zowel naar Sheet1 kolom 5 als Sheet1 kolom 6 verwijzen zeg maar dat die zoekt in allebei de kolommen.

 

[HSV]

Zo dus.

With Sheets("Sheet1").Columns(5).resize(,2)

 

[martindeboer1988]

Precies dat ja, Dank je wel :thumb: