[Excel] Script error bij zoeken naar woord

Status
Niet open voor verdere reacties.
B

bspeedy

Gebruiker
Lid geworden
13 okt 2007
Berichten
12
Hallo,

Heb een query gemaakt, maar krijg een error.

Ik heb data in kolom A en kolom B staan. Ik wil kolom A doorzoeken op een woord, dat ik in H2 op blad2 aangeef. De data moet naar blad 2 gaan (als die voldoet aan mijn query) en de datasheet staat in blad1.

Als ik deze echter uitvoer, krijg ik ee error bij "WerkRij = WerkRij + 1"

Wie weet waar de fout zit? alvast bedankt!

Code: 
Sub Opzoeken()
Dim Woord As String
Dim DataBlad As Worksheet, WerkBlad As Worksheet
Dim Rng As Range
Dim MaxRij As Long, Rij As Long, StartRij As Long, WerkRij As Integer
Dim Flag As Boolean

Flag = True
Set DataBlad = Sheets("Blad1")
Set WerkBlad = Sheets("Blad2")

WerkBlad.Range("A2:C65536").ClearContents
WerkRij = 3

Woord = Trim(WerkBlad.Range("H2").Value)
MaxRij = DataBlad.Range("B65536").End(xlUp).Row + 3

StartRij = 1

Do While Flag = True
Set Rng = DataBlad.Range("A:A").Find(what:=Woord, LookIn:=xlValues, lookat:=xlPart)
If Rng Is Nothing Then
Flag = False
Else
Rij = Rng.Row
WerkBlad.Range("A" & WerkRij & ":B" & WerkRij).Value = DataBlad.Range("A" & Rij & ":B" & Rij).Value


End If
WerkRij = WerkRij + 1
StartRij = Rij + 1
Loop

Set DataBlad = Nothing
Set WerkBlad = Nothing

End Sub
 
Je hebt de variabele werkrij als type 'integer' gedefinieerd en die mag maar circa 32768 regels groot zijn, terwijl je tot aan rij 65536 wilt gaan. Werkrij zal dan waarschijnlijk ook het getal 32768 bevatten.

Dimensioneer de variabele werkrij als type 'long' en het gaat goed. denk ik...:D
 
hij blijft nog steeds "hangen", dus het werkt niet echt...
Hij geeft de waarden van de eerste rij aan en dit in de hele kolom A en B (dus bijv test in kolom A onder elkaar en 123 in kolom B onder elkaar)
 
Laatst bewerkt:
Heb je een voorbeeld bestand? Dat kijkt wat makkelijker waar het fout gaat...
 
Als ik het trouwens zo zie, dan doet je code nagenoeg niets. Je blijft dezelfde rij evalueren, namelijk de eerste lege rij van kolom A, en dat is het... De loop is dus oneindig en geeft dan een foutmelding.

Kun je aangeven wat je wilt, in plaats van dat we moeten controleren wat er in de code foutgaat? Misschien kan wat jij wilt namelijk wel anders (lees: makkelijker)?

groeten Eelco
 
Mijn code moet een lijst doorzoeken op een woord. In mijn werkblad moet dan de lijst weergegeven worden van de rijen waar eht woordt dat ik zoek naar voren kom. Bijv: ik zoek holiday. Dan moet deze code gaan zoeken op artiest naam (A) en song (B) en waar het woord holiday voorkomt, de rijen naar een ander werkblad kopieren.
 
Wel met je
Code: 
Set Rng = DataBlad.Range("A:A").Find(what:=Woord, LookIn:=xlValues, lookat:=xlPart)
zal het volgens mij niet lukken omdat als je woord in de lijst voorkomt je variabele "Rng" een waarde krijgt.
Je test
Code: 
If Rng Is Nothing Then
is dan altijd False waardoor je nooit meer uit de Do While lus geraakt.

Ik krijg zelfs "Fout 6 tijdens uitvoering: Overloop" daar Werkrij nog steeds een Integer is. Spel stopt aan 32767:evil:

In het Werkblad heb ik dan mij woord in cellen A3 tem A32767 :evil:


Nu, ik heb ooit zoiets gemaakt om eender welke lettercombinatie te gaan zoeken in artiesten-naam, song-naam en CD-naam.
Je moet zelfs ingeven hoe hij het moet interpreteren:
Only this word : enkel als één woord
With this word : zelfstandig woord ergens tussen andere woorden
First word : zelfstandig woord vooraan andere woorden
Last word : zelfstandig woord achteraan andere woorden
With these char : karakters eender waar

Een ingave "van" kan dus als woord of opeenvolgende karakters in een woord beschouwd worden afhankelijk van wat je kiest.

Code: 
    'Range bepalen waarin moet gezocht worden
    intFirstRow = objDataSheet.Range("FirstPerformer").Row
    intLastRow = objDataSheet.Range("FirstPerformer").End(xlDown).Row

    'Lus voor alle rijen in "Data"
    For intRow = intFirstRow To intLastRow
        'Reset bitje "data voldoet aan criteria"
        blnOk = True
        'Info om de 10 rijen van "Data"
        If intRow Mod 25 = 0 Then
            lblsbText.Caption = " Searching... ... " & CStr(intLastRow - intRow) & " records to go."
            DoEvents
        End If


        If ((chkOwner.Value = False) Or _
           ((chkOwner.Value = True) And (objDataSheet.Cells(intRow, 4).Value <> ""))) Then
            'Deze testen enkel maar uitvoeren als Owner = False
            '                                  OF Owner = True  EN CD Title <> ""
            'Lus voor alle kolommen in grid Selection
            For i = 1 To grdSelection.Cols - 1
                'Check als er een criteria ingevuld is voor die kolom
                If grdSelection.Cell(flexcpText, 3, i) <> "" Then
                    'Exact match of slechts bevatten
                    Select Case X(i)
                        'Omschrijving       format voor LIKE                    Code in array X     Gebruiken bij
                        'Only this word     data                                1                   letters en cijfers
                        'With this word     data | *_data | *_data_* | data_*   2                   letters
                        'First word         data_*                              3                   letters
                        'Last word          *_data                              4                   letters
                        'With these char    *data  |  *data*  | data*           5                   letters en cijfers
                        'Starting with      data*                               6                   cijfers
                        'Ending with        *data                               7                   cijfers
                        '
                        Case 0  'geen selectie ingegeven
                            lblsbOk.Visible = False
                            lblsbBusy.Visible = False
                            lblsbError.Visible = True
                            lblsbText.Font.Bold = True
                            lblsbText.Caption = " No search method selected for column [" & grdSelection.Cell(flexcpText, 1, i) & "] !!"
                            Exit Sub
                            
                        Case 1  'Only this word: data
                            strDummy = grdSelection.Cell(flexcpText, 3, i)
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                blnOk = False
                                Exit For
                            End If
                        
                        
                        Case 2  'With this word: data | *_data | *_data_* | data_*
                            strDummy = grdSelection.Cell(flexcpText, 3, i)
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, volgende test uitvoeren
                                strDummy = "* " & grdSelection.Cell(flexcpText, 3, i)
                                If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                    'Data voldoet niet, volgende test uitvoeren
                                    strDummy = "* " & grdSelection.Cell(flexcpText, 3, i) & " *"
                                    If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                        'Data voldoet niet, volgende test uitvoeren
                                        strDummy = grdSelection.Cell(flexcpText, 3, i) & " *"
                                        If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                            'Data voldoet niet na de vier testen, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                            blnOk = False
                                            Exit For
                                        End If
                                    End If
                                End If
                            End If
                        
                        Case 3  'First word: data_*
                            strDummy = grdSelection.Cell(flexcpText, 3, i) & " *"
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                blnOk = False
                                Exit For
                            End If
                        
                        
                        Case 4  'Last word: *_data
                            strDummy = "* " & grdSelection.Cell(flexcpText, 3, i)
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                blnOk = False
                                Exit For
                            End If
                        
                        
                        Case 5  'With these char: *data  |  *data*  | data*
                            strDummy = "*" & grdSelection.Cell(flexcpText, 3, i)
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, volgende test uitvoeren
                                strDummy = "*" & grdSelection.Cell(flexcpText, 3, i) & "*"
                                If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                    'Data voldoet niet, volgende test uitvoeren
                                    strDummy = grdSelection.Cell(flexcpText, 3, i) & "*"
                                    If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                        'Data voldoet niet na de drie testen, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                        blnOk = False
                                        Exit For
                                    End If
                                End If
                            End If
                        
                        
                        Case 6  'Starting with: data*
                            strDummy = grdSelection.Cell(flexcpText, 3, i) & "*"
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                blnOk = False
                                Exit For
                            End If
                           
                            
                        Case 7  'Ending with: *data
                            strDummy = "*" & grdSelection.Cell(flexcpText, 3, i)
                            If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then
                                'Data voldoet niet, reset controle bit en lus verlaten (andere kolommen niet meer testen)
                                blnOk = False
                                Exit For
                            End If
                                                
                                                
                        Case Else
                            lblsbOk.Visible = False
                            lblsbBusy.Visible = False
                            lblsbError.Visible = True
                            lblsbText.Font.Bold = True
                            lblsbText.Caption = " Error in [Private Sub cmdSearch_Click()_Select Case X(i)] !!"
                            Exit Sub
                    End Select
                End If
            Next i

        Else
            'Data voldoet niet omwille van Owner
            blnOk = False
        End If
        
        'Indien data voldoet toevoegen in grdResult
        If blnOk = True Then
            intCol = 0
            intCounter = intCounter + 1
            grdResult.Rows = grdResult.Rows + 1
            'grdResult.Cell(flexcpText, grdResult.Rows - 1, 0) = CStr(intCounter)
            'Lus voor alle kolommen in grid Selection
            For i = 1 To grdSelection.Cols - 1
                'Check als data gewenst is
                If grdSelection.Cell(flexcpChecked, 2, i) = flexChecked Then
                    grdResult.Cell(flexcpText, grdResult.Rows - 1, intCol) = objDataSheet.Cells(intRow, i).Value
                    intCol = intCol + 1
                End If
            Next i
        End If

    Next intRow
De code as is zal je niet kunnen gebruiken omwille van oa. "grdSelection" Dat is een gekochte ActiveX control die je hoogst waarschijnlijk niet hebt :o
Den truck zit in de LIKE instructie.
Je moet wel door alle rijen van je data lopen en die vergelijken met je ingave.
Bij mij zitten er +8000 rijen met data toch gaat dat in een fractie van een seconde :)

Was dit een beetje duidelijk :thumb: of juist niet :eek:
 
Laatst bewerkt door een moderator:
Thanx voor je help!
Van jouw code wordt ik echter niet heel veel wijzer... Is er een specifiek gedeelte dat ik voor de mijne moet gebruiken? Of heb je een suggestie om die loop wel goed te krijgen?
Alvast bedankt!
 
bspeedy zei:
Is er een specifiek gedeelte dat ik voor de mijne moet gebruiken?
Klik om te vergroten...
Absoluut, anders zou ik het niet geplaatst hebben :o

De "For intRow = intFirstRow To intLastRow" kan je gebruiken om door alle rijen data te lopen.

Alle "If Not objDataSheet.Cells(intRow, i).Value Like strDummy Then" kan je gebruiken om te bepalen of de actuele cel voldoet aan het gevraagde.
Let wel dat je eerst "strDummy" moet invullen volgens hetgeen je wenst te zoeken, een woord in het midden, eerste woord, laatste woord of opeenvolgende karakters eender waar.
Dat doe je met alle "strDummy = "* " & grdSelection.Cell(flexcpText, 3, i) & " *"" instructies. Dit is het voorbeeld voor 'woord in het midden'. De andere mogelijkheden staan duidelijk aangegeven in de code.

De "Select Case X(i)" is een onduidelijk truckske :p
Die jij misschien niet zult nodig hebben :D
Onthou enkel dat in array X de zoek methode zit voor elke kolom 'index i).


Mijn macro heeft een user form met een "Selection" grid (grdSelection).
Kolom 1 alles over artiest, kolom 2 alles over song, ... ...
In rij 1 kan de gebruiker aangeven of die kolom gebruikt is
In rij 2 kan de gebruiker de te zoeken karakters ingeven. Dit is "grdSelection.Cell(flexcpText, 3, i)" in de code
In rij 3 kan de gebruiker de interpretatie van de karakters ingeven, een woord in het midden, eerste woord... ...
Voor iedere rij data wordt gekeken of "artiest" voldoet aan ingave, "song" voldoet aan ingave, "CD" voldoet aan ingave, ... ...

Bottom line: Je moet de LIKE instructie gebruiken.
Hoe ze in je code vervat zit zal afhangen van een aantal andere zaken zoals, user interface, locatie data, zoekcriteria, locatie resultaat, ... ...
De geplaatste code werkt perfect voor mijn lay-out :shocked:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan