22. september 2007 - 23:12Der er
4 kommentarer og 3 løsninger
Søge funktion
Hej
Jeg er ved at oprette et lokations ark
Jeg skal bruge et søge felt, som efter endt søgning hopper til rækken med den søgte person eller omkring personen hvis ikke søge resultatet er helt præsis, der efter skal jeg kunne overføre alle data i rækken for den valgte person til et print ark.
Jeg har en mappe med 3 ark. ark1 er forside/søg, ark2 er data, ark 3 er forud defineret, som print side.
Eksempel:
Jens Hansen har på skift 1 cykel opbevaret hos os. Den ene er en SCO den anden en Kildemose, jeg skal arkivere den på lokation A1 og tilføje stand.
Jens skal underskrive en kvittering på den cykel han indlevere og den han får udleveret. Jeg skal let kunne mærke hans cykel med lokation og navn med en dymo
Jeg skal finde Jens Hansen, ( hans data ligger i ark2, række3)
i første kolonne er hans efternavn, 2kolonne er hans navn, 3kolonne er hans cykel, i 4kolonne er hans lokation, og sidst i 5kolonne er standen.
når jeg så endeligt har valgt jens hansen skal data overføres til ark3 hvor jeg kan printe en dymo og en kvittering.
derefter skal jeg ind og rette kolonnen til den cykel han indlevere og printe ud igen
Test om den kan bruges, så tager vi resten derfra men er først tilbage senere på dagen.
Sub søgKunde() fNavn = Sheets("Ark1").Range("C4") ' ret til aktuel ark og celle eNavn = Sheets("Ark1").Range("B4") ' ret til aktuel ark og celle If eNavn = Empty Or fNavn = Empty Then Beep: Beep: Exit Sub Sheets("Ark2").Select ' ret evt. ark navn On Error Resume Next 'Find første efternavn, hvis Fornavn passer så hop ud Range("A2:A100").Find(eNavn, LookIn:=xlValues).Select ' tester i 100 rækker, ret evt If Selection.Offset(0, 1) = fNavn Then Application.Goto ActiveCell, True Exit Sub End If 'Test resterende Efternavne, hvis Fornavn passer så hop ud første = Selection.Row While Selection = eNavn Cells(første + antal, 1).Select If Selection = eNavn And Selection.Offset(0, 1) = fNavn Then Exit Sub antal = antal + 1 Wend 'Ingen match fundet, gå til første tomme række for nyt navn Cells(Cells(65500, 1).End(xlUp).Row + 1, 1).Select
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
