Loop untill

Status
Niet open voor verdere reacties.
R

roastfreak

Gebruiker
Lid geworden
20 apr 2009
Berichten
42
Beste

Ik heb een excel bestand met een goede 56000 lijnen
Hierin komen een aantal keren het woord WAF in voor
De waarde achter deze waf kopieer ik naar een andere worksheet
Zo loop ik de ganse lijst door tot alle 56000 lijnen zijn doorgelopen
Tot hiertoe loopt alles prima
Ik moet toegeven, de code is niet zelf samengesteld, vandaar deze misschien ietwat logische vraag voor jullie
Hoe kan ik nu uit deze loop geraken, hij blijft nl maar loopen...
De lijst met 56000 lijnen is een onderbroken lijst, er staan lege rijen tussen

Mvg,
Tim
 
Dit is de code tot hiertoe

Sub Macro1()
Dim findthis As String
Dim counter As Integer

Sheets("Lijst").Select
Range("A1:N65536").Select

findthis = InputBox("Geef te zoeken waarde in", "Zoek")

Do
Cells.Find(What:=findthis, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate


ActiveCell.Offset(0, 1).Copy Sheets("Tabel").Range("a65536").End(xlUp).Offset(1, 0)

Loop

End Sub
 
Zet svp VBA-code tussen code-tags (#)

Waarom niet de ingebouwde Excel-funktionaliteit gebruiken ?
Code: 
Sub Macro1()
  With Sheets("Lijst").usedrange
     .autofilter 1,"WAF"
     .specialcells(xlcelltypevisible).copy Sheets("Tabel").cells(rows.count,1).End(xlUp).Offset(1, 0)
     .autofilter
  End With
End Sub
 
Bedankt voor de tip
De autofilter functie duurt ontzettend lang, te lang om goed te zijn
Heb het net even getest, zonder andere bewerkingen uit te voeren loopt hij al 10min...
Heb je nog andere tips ?

Alvast bedankt
 
roastfreak zei:
Hoe kan ik nu uit deze loop geraken, hij blijft nl maar loopen...
Klik om te vergroten...

Dag Tim

In de helpfiles van VBA staat bij Find een voorbeeld met een FindNext. Daar kan je inspiratie opdoen.

Haal nog even de Select's, Activate's en ActiveCell's uit je code en je code zal op de koop toe nog een stuk sneller lopen.

Vooraleer weg te schrijven kan je ook de resultaten in een Array zetten en in 1 schrijfbeweging die Array naar een blad overbrengen.

Wigi
 
Hiermee zou het razendsnel moeten gaan:

Code: 
Sub stts()
  With Sheets("lijst").UsedRange
    sq = .value
    For j = 1 To .Columns.Count - 1
      c0 = join(WorksheetFunction.Transpose(.Columns(j)),"|")
      sr = Split(c0, [COLOR="Blue"]"WAF"[/COLOR])
      For jj = 1 To UBound(sr)
        c2 = c2 & sq(UBound(Split(Split(c0, sr(jj))(0), "|")) + 1, j + 1) & "|"
      Next
    Next
  End With
  sp = Split(c2, "|")
  Sheets("Tabel").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = WorksheetFunction.Transpose(sp)
End Sub
 
Laatst bewerkt:
Kan je me een voorzet geven die ik op een aantal m van de doellijn moet binnen koppen ?
Van arrays heb ik geen kaas gegeten...

Mvg,
Tim
 
@ snb

Heel eventjes doet ie het (onderbroken modus)
Maar dan blijft de code hangen bij de volgende regel

sr = Split(Join(sn, "|"), "WAF")


Helpt het je als ik het bestand erbij plak?

Mvg,
Tim
 
Ik heb een stukje van de file gekopieerd en toegevoegd in deze bijlage
Deze lijst is in wezen meer dan 56000 lijnen lang
Zoals je ziet komt telkens het woord WAFPO terug, de waarde achter dit woordt had ik graag in de worksheet tabel geplaatst
Met de makro die ik nu reeds had, kopieerde hij de WAFPO nrs al in de worksheet Tabel, maar ik blij in de loop zitten en hij start telkens opnieuw met kopieren

Een volgende stap is de waarden (meestal 3 kolommen, soms 6) achter het woord "waviness" in de kolom te kopieren achter het getal van de wafpo dat we daarvoor al in de worksheet tabel hadden geplaatst
Dus eigenlijk het volgende

Kolom A Kolom B Kolom C KolomD KolomE kolom F kolom G
(WAFPO) (Waviness)
12742 0.099 0.104 0.104 0.055 0.125 0.078
 

Bijlagen

Vergeet het maar: begin met het verwijderen van samengevoegde cellen.
 
Handig dat de namen van de werkbladen gewijzigd zijn.
Ook handig dat het gegeven achter "waf" 2 kolommen verder staat.
Het lijkt alsof er maar 1 kolom is met gegevens waarin "WAF" voorkomt.
Als dat zo is, kan deze aktie natuurlijk veel eenvoudiger.

De aangepaste macro werkt naar behoren:
Code: 
Sub stts()
  With Sheets([COLOR="Red"]"Sheet1"[/COLOR]).UsedRange
    sq = .Value
    For j = 1 To .Columns.Count - 1
      c0 = Join(WorksheetFunction.Transpose(.Columns(j)), "|")
      sr = Split(c0, "WAF")
      For jj = 1 To UBound(sr)
        c2 = c2 & sq(UBound(Split(Split(c0, sr(jj))(0), "|")) + 1, j [COLOR="red"]+ 2[/COLOR]) & "|"
      Next
    Next
  End With
  sp = Split(c2, "|")
  Sheets([COLOR="red"]"sheet2"[/COLOR]).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sp) + 1) = WorksheetFunction.Transpose(sp)
End Sub
 
SNB

Alvast bedankt voor het werk, maar...het wil niet lukken
Tis te zeggen in mijn voorbeeld, loopt het als een klokske, maar in de werkelijke file blijft hij hangen bij de volgende regel

c0 = Join(WorksheetFunction.Transpose(.Columns(j)), "|")

Volledige file kan ik niet uploaden, maar ik tracht je nog een langere versie te sturen
Kan je aub even nakijken wat er schort ?

Nogmaals bedankt

Mvg,
Tim
 
Allen,

In bijlage het bestand, ik zie dat de gekopieerde lijst (in tabblad sheet 2) niet overeenstemt met de werkelijke lijst in sheet 1
Geraak er niet uit in de codering
Bovenstaand probleem dat hij vastloopt geld ook nog steeds
Kunnen jullie mij helpen

Mvg,
Tim
 
Probeer te begrijpen wat de macro doet. Dan kun je er zonodig zelf wijzigingen in aanbrengen.
 
De code klopt niet helemaal, hij heeft soms dezelfde waarden achter elkaar, en laat soms waarden weg
Wat zie ik over't hoofd ?

Mvg,
Tim
 
Je ziet over het hoofd dat wij geen helderzienden zijn.
Zonder bijgevoegd bestand valt de werking van de macro niet te beoordelen. In het eerder geplaatste bestand werkt de macro nl. vlekkeloos.
 
@snb

Ik tracht morgen op kantoor nogmaals een voorbeeldje erbij te doen, ligt momenteel niet bij mij thuis
Alvast bedankt voor het proberen !

Mvg,
Tim
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan