Userform data-set laten doorzoeken en enkele data kopieeren?

Status
Niet open voor verdere reacties.
K

kbraakman

Gebruiker
Lid geworden
6 nov 2016
Berichten
10
Goedenavond,

Ik probeer door middel van een userform een data-set te doorzoeken. In het userform zijn drie comboboxes beschikbaar, in iedere combobox zijn een aantal opties mogelijk. Zodra er een combinatie is gemaakt moet er op de button worden gedrukt en dan moet er in de dataset worden gezocht naar die combinatie. Als deze combinatie(s) bestaan en zijn gevonden dan moeten er uit die betreffende rij 5 gegevens die bij die combinatie horen worden gekopieerd naar een ander blad.

En vervolgens moet er op de andere knop gedrukt worden zodat het tweede blad weer wordt geleegd en er een nieuwe zoek opdracht plaats kan vinden.

De opties toevoegen aan de comboboxes is niet zo spannend, echter loop ik tegen wat problemen aan wanneer ik een code schrijf die de dataset doorzoekt en die specifieke data dan ook kopieert.

Als iemand enig idee heeft of mij in de juiste richting kan krijgen zou dat mij heel erg helpen!

Bij voorbaat dank! :)

PS. Dataset is nog zon 4000 regels groter. Anders kon ik de bijlage niet uploaden.
PPS. Kolom J op Blad1 is " Airline "

Bekijk bijlage Dataset1.xlsm
 
Laatst bewerkt:
Wat moet er waarom leeggemaakt worden het formulier of een werkblad?

Om de gegevens te zoeken en op te slaan
Code: 
Dim ar
Private Sub Userform_Initialize()
  ar = Sheets("Flightlist").Cells(1).CurrentRegion
  ComboBox1.List = Split("NAX QTR VLG")
  ComboBox2.List = Split("A319 A320 A321 A332 A333 B734 B737 B738 B788 B789")
  ComboBox3.List = Split("L M H J")
End Sub
Private Sub CommandButton2_Click()
  For j = 1 To UBound(ar)
    If ComboBox1 = ar(j, 10) And ComboBox2 = ar(j, 11) And ComboBox3 = ar(j, 12) Then
      Sheets("FlightlistOutput").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Array(ar(j, 1), ar(j, 2), ar(j, 4), ar(j, 9), ar(j, 13))
      Exit For
    End If
  Next j
End Sub
 
Bedankt voor je antwoordt! Terugkomend op jouw vraag: zodra de data geprint is in het tweede blad zou je via een druk op een andere button de zojuist gekopieerde data weer verwijderen zodat het blad leeg is en gereed is voor een nieuwe zoekfunctie.

De code hierboven werkt; echter is het maar voor een enkele zoekactie. Het is de bedoeling dat alle 14000 rijen worden doorzocht en keer op keer de gekozen combinatie (die sowieso meerdere keren voorkomt) wordt herkend en overgenomen in het tweede blad. Weet jij toevallig hoe dit gedaan moet worden?

Nogmaals bij voorbaat dank!
 
En om je combobox alleen unieke items te laten zien zet je zo'n soort module er in.
ps tx1 is hier een combobox, de benaming txt1 was om een auto clear op al mijn invoervelden (meeste textboxen) te kunnen doen op mijn userform.

Code: 
Sub uniek()

    Dim total_row As Integer
    Dim i As Integer
    Dim check As Boolean
    Dim k As Integer
    
    total_rows = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To total_rows
    
        check = True
        
        For k = 0 To txt1.ListCount - 1
            If Sheet2.Cells(i, 1).Value = txt1.List(k) Then
                check = False
                Exit For
            End If
        Next k
        
        If check Then
            txt1.AddItem Sheet2.Cells(i, 1).Value
            'Txt2.Value = Sheet2.Cells(i, 2).Value
        End If
        
    Next i
    
  End Sub
 
Laatst bewerkt:
Als je de Exit For eruit haalt dan krijg je toch ook de andere resultaten?

Bedoel je zoiets?
Code: 
Private Sub CommandButton2_Click()
  With Sheets("FlightlistOutput")
    .Cells(1).CurrentRegion.Offset(1).ClearContents
    For j = 1 To UBound(ar)
      If ComboBox1 = ar(j, 10) And ComboBox2 = ar(j, 11) And ComboBox3 = ar(j, 12) Then .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = Array(ar(j, 1), ar(j, 2), ar(j, 4), ar(j, 9), ar(j, 13))
    Next j
    .Cells(1).CurrentRegion.PrintOut
  End With
  For j = 1 To 3
    Me("Combobox" & j) = ""
  Next j
  ComboBox1.SetFocus
End Sub
 
Top dankjewel, het werkt! Nog wat gesleuteld aan de bestaande code en het werkt! Mocht ik nog tegen wat dingen aan lopen dan laat ik het weten!
 
Daar kan wel iets meer snelheid in.
Code: 
Private Sub CommandButton2_Click()
ReDim sq(4, 0)
  For j = 1 To UBound(ar)
    If ComboBox1 = ar(j, 10) And ComboBox2 = ar(j, 11) And ComboBox3 = ar(j, 12) Then
     sq(0, UBound(sq, 2)) = ar(j, 1)
     sq(1, UBound(sq, 2)) = ar(j, 2)
     sq(2, UBound(sq, 2)) = ar(j, 4)
     sq(3, UBound(sq, 2)) = ar(j, 9)
     sq(4, UBound(sq, 2)) = ar(j, 13)
     ReDim Preserve sq(4, UBound(sq, 2) + 1)
     End If
  Next j
 For j = 1 To 3
    Me("Combobox" & j) = ""
  Next j
  ComboBox1.SetFocus
 With Sheets("FlightlistOutput")
   .Cells(1).CurrentRegion.Offset(1).ClearContents
   .Range("A2").Resize(UBound(sq, 2) - 1, 5) = Application.Transpose(sq)
   '.Cells(1).CurrentRegion.PrintOut
 End With
End Sub
 
Hi,

Het enige wat mij nog rest is een stukje code voor wanneer je in de drie comboboxes een combinatie invult die niet bestaat(niet in de lijst) dat er dan een msgbox komt die je dit verteld.

Thanks
 
Dat userform lijkt me 100% overbodig.
Het tweede werkblad overigens ook
Gebruik de 'intelligente' tabel in Excel. Verberg de kolommen die je niet als output of selectiekolom nodig hebt.

Je probeert met een userform ingebouwde funktionaliteit opnieuw uit te vinden.
 

Bijlagen

  • __overbodig wiel snb.xlsx
    1,4 MB · Weergaven: 43
Laatst bewerkt:
Wat je zegt klopt en dat is ook niet zo heel moeilijk. Echter is dat niet het idee erachter. Er moet gebruik worden gemaakt van het userform. Toch bedankt voor het meedenken!
 
Data-set dient doorzocht te worden dmv een userform. Zie uitleg in mijn eerste vraag. Echter hoe je dat doet en welke opties je wilt toevoegen aan je userform mag je zelf bepalen.
 
Het laatste stukje.
Code: 
With Sheets("FlightlistOutput")
   .Cells(1).CurrentRegion.Offset(1).ClearContents
   if ubound(sq,2) = 0 then
       msgbox "bestaat niet"
     else
      .Range("A2").Resize(UBound(sq, 2) - 1, 5) = Application.Transpose(sq)
     end if
   '.Cells(1).CurrentRegion.PrintOut
 End With
 
Heren,

Ik heb het gekibbel er maar even uitgehaald.

@TS, volgende keer even die post in de gaten houden en dan komt het allemaal wel goed :)

Voor nu,
Fijne dag allemaal :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan