Hej!
Det blir ganska många rader kod, men du får väl ta det som lite bra träning. Här är ett tips på hur du klurar ut hur man gör:
1. Öppna en helt ny arbetsbok och skriv ut ett startvärde "aaa" någonstans utom i A1 och någonstans efter det ett slutvärde zzz
2. Starta inspelning av ett macro. Börja macrot med att markera A1 sök därefter efter texten "aaa".
3. Avsluta inspelningen och se hur macrot blev.
4. Du har nu kod för att finna första raden såvida inte aaa står redan i A1.
5. Ändra macrot ovan så att det med en if-sats granskar om A1 har värdet aaa annars söker macrot efter första aaa.
6. Du kan skriva debug.print ActiveCell.Row för att i direktfönstret se vilken rad det blev som markerades, fast det ser du ju egentligen ändå..
7. Deklarera nu upp följande variabler:
lStartRow as long
lEndRow as long
lPreviousRow as long
bContinueToSearch as boolean
lKillLoop as long
Dessa variabler skall du använda för att så småningom hitta alla rader.
8. Komplettera macrot så att det återigen granskar om den funnit texten aaa (if AcitveCell.value = "aaa" then...)
I så fall sätts bContinueToSearch till true. Dessutom sätts lStartRow till = ActiveCell.Row och lPreviousRow sätter vi till lStartRow.
9. Skapa nu en loop while bContinueToSearch =true
10. I denna loop börjar du med att räkna upp lKillLoop med ett för varje varv. Om den blir säg 10000 så sätter du bContinueToSearch till false. Observera att denna if-sats alltid skall vara precis före wend eftersom vi skall ändra på bContinueToSearch lite högre upp, och vi vill inte fastna i en evig loop... för då blir vi ju kanske av med vår källkod om vi inte sparat.
11. Det första vi skall göra i loopen är att leta efter första zzz utifrån den plats där vi stod (vilket ju är första aaa). Vi har redan kod för att söka efter aaa...
12. När vi sökt efter zzz vet vi inte om vi funnit zzz eller står kvar på aaa därför att zzz saknas. Det spelar ingen roll, för i så fall finns bara texten aaa i hela dokumentet. Oavsett vad sätter vi lEndRow till den rad som just nu är activecell.
13. För testsynpunktsskull sätter vi tillfälligt bContinueToSearch till false och efter loopen så skriver vi Range(lStartRow & ":" & lEndRow).Select Vi markerar så vår första range, men det där med att sätta bContinueToSearch till false kommenterar vi bort direkt när vi sett att det fungerar.
14. Vi skall bara fortsätta vår loop om det finns ett nytt aaa som ligger efter det aaa där vi befinner oss. Därför söker vi i loopen (efter det att vi noterat lEndRow) efter nästa "aaa". När vår sökning är klar granskar vi att vi funnit texten aaa samt att den nya raden ligger efter tidigare lPreviousRow. Om lStartRow är mindre eller likamed lPreviousRow är risken uppenbar att vi stannar i en evig loop. Därför måste den nya raden vara efter lPreviousRow. Om det kan stå flera aaa på samma rad så måste vi även ha variabeln lPreviousColumn och granska att den nya kolumnen är högre om startraden är samma som lPreviousRow.
Om vi finner en ny aaa så sätter vi bContinueToSearch till true annars sätter vi den till false. Vi sätter även lPreviousRow till den nya raden för aaa. Spara nu filen och testkör. Har du gjort rätt skall du inte fastna i en loop. Har du gjort som jag beskriver men ändå fastnar så har jag missat något och du får nog själv klura ut vad...
15. Loopen ovan kommer bara att finna sista rangen aaa-zzz. För att fånga alla ranges så skapar vi variabeln sRange och variabeln sComma, båda skall vara strängar.
16. När vi finner en range så utökar vi sRange till enligt nedan:
' En range kan anges som startrad:slutrad och flera kan anges med komma däremellan
sRange = sRange & sComma & lStartRow & ":" & lEndRow
' först är sComma tomt, men nästa gång skall den vara ett komma
sComma = ","
17. Loopen bygger nu upp en sträng med de ranges som skall markeras. Ändra den markering du gör sist i koden (jämför p. 13 ovan) så att den istället markerar sRange.
Jaha, detta var det hela! Om du inte löser det så kan du kontakta oss på Excelspecialisten och ge oss det som ett uppdrag, om det är viktigt för dig att finna en lösning och du inte kan göra det själv. Vi har telefon 031 - 340 44 00
Mvh
/Kihlman