[Excel VBA] Zoeken naar zelfingevoerde waarde

Pagina: 1
Acties:
  • 1.264 views sinds 30-01-2008
  • Reageer

  • Chillout
  • Registratie: Juni 2000
  • Laatst online: 03-09-2025
Goedemiddag.
Hier is waar ik niet uitkom:

Ik heb een waarde in een veld ingevuld. Nu moet excel gaan zoeken naar deze waarde in een kolom, en wanneer deze is gevonden, moet de hele rij geselecteerd en verplaatst worden.
Hoe krijg ik dit voor elkaar?

Ik kreeg zonet dit van een collega, maar daar heb ik weinig aan, omdat ie op een hardcoded iets gaat zoeken, en dat willen we niet... Ik wil dus bijvoorbeeld zoeken op een waarde die in veld B3 op blad "Tester Invoer" staat, maar dat schijnt de Find functie dus niet te ondersteunen ...

Help!
code:
1
2
3
4
5
6
Sheets("Database").Select
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
    Cells.Find(What:="bla", After:=ActiveCell, LookIn:=xlValues, LookAt _
      :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
      False).Activate

  • Skinny
  • Registratie: Januari 2000
  • Laatst online: 13-09 23:09

Skinny

DIRECT!

Zet op de sheet "Tekst" in kolom 1 een aantal waarden onder elkaar.
De gezochte waarde wordt gehaald uit de cell B3 op de sheet "Invoer".

Procedure :
- Loop door alle waarden in kolom 1 heen (de Do / Loop)
- Als de waarde gevonden is, verplaats dan de regel
- Selekteer daarna de regel (die nu leeg is) en verwijder hem.

De gezochte waarde (regel) staat nu op regel 15 (destinationRow)
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sheets("Tekst").Select
Range("A1").Select

DestinationRow = 15

Do While ActiveCell.Value <> ""
    
    If Sheets("Invoer").Range("B3").Value = ActiveCell.Value Then
        
        MsgBox ActiveCell.Value & " gevonden op regel " & ActiveCell.Row
        
        'Verplaats naar regel DestinationRow
        Rows(Trim(Str(ActiveCell.Row))).Select
        Selection.Cut Destination:=Rows(Trim(Str(DestinationRow)))
        'Verwijder lege regel
        
        Rows(Trim(Str(ActiveCell.Row))).Select
        Selection.Delete Shift:=xlUp
    End If
    
    ActiveCell.Offset(1, 0).Select
Loop

SIZE does matter.
"You're go at throttle up!"


  • Chillout
  • Registratie: Juni 2000
  • Laatst online: 03-09-2025
thenks,
ga het gelijk even proberen :)

  • Chillout
  • Registratie: Juni 2000
  • Laatst online: 03-09-2025
Okay, ik heb het nu alsvolgt opgelost:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub CommandButton2_Click()
    Sheets("Database").Select
    Sheets("Database").Range("A2").Select
    
    'Plaats waarop data tijdelijk wordt gesaved = 9999, dus dan wordt DestinationRow 9999+1=10000
    DestinationRow = 10000
    
    Do While ActiveCell.Value <> ""
      If Sheets("Invoer Tester").Range("B3").Value = ActiveCell.Value Then
      MsgBox ActiveCell.Value & " gevonden op regel " & ActiveCell.Row
                       
        'Maak lege regel waar resultaat in moet komen
                               
        'Selecteer regel met gezochte waarde
        Sheets("Database").Rows(Trim(Str(ActiveCell.Row))).Select
                      
        'Knip regel en Verplaats naar regel DestinationRow
        Selection.Cut Destination:=Sheets("Database").Rows(Trim(Str(DestinationRow)))
        
        'Verwijder lege regel
        Sheets("Database").Rows(Trim(Str(ActiveCell.Row))).Select
        Selection.Delete Shift:=xlUp
        
            Sheets("Database").Rows("9999:9999").Select
            Selection.Cut
            Sheets("Database").Rows("2:2").Select
            Selection.Insert Shift:=xlDown
        
    End If
   
    ActiveCell.Offset(1, 0).Select
Loop
  
End Sub

Om overschrijven van bekende data te voorkomen, maak ik gebruik van een tijdelijke locatie waar alles opgezet wordt (rij 9999). De data wordt hierna ingevoegd op row 1.

Bedankt voor je hulp.
Groeten,

Jille