20 gegevens verwerken in een sheet met 5000 lijnen

Status
Niet open voor verdere reacties.
M

marccram

Gebruiker
Lid geworden
20 dec 2015
Berichten
40
in blad 1 van mijn sheet staan 5000 rijen : kolom A bevat het artikel nummer, kolom B een omschrijving , kolom C de minimum stock, kolom D de aankoop prijs
de gegevens zijn gesorteerd op artikel nummer (=kolom A )
in blad 2 staan 20 artikels met een nieuwe minimum stock : kolom A bevat het artikel nummer, kolom B de nieuwe minimum stock
( voor alle 20 artikels in er een andere waarde voor de minimum stock )
bedoeling is : in blad 1 moeten die 20 artikels ( vermeld in blad 2 ) de nieuwe minimum stock krijgen die in blad 2 is vermeld
ik ken niets van VBA
kan iemand mij de VBA codering geven die deze updating kan uitvoeren ?
die 20 artikels van blad 2 staan ergens in de 5000 rijen van blad 2
( nice to have : als een artikel van blad "is verwerkt" kan dan in kolom C van blad 2 de waar OK geplaatst worden, indien het artikel niet werd gevonden in blad 1 dan de waarde 'niet gevonden" in kolomC )
 
En waar is je voorbeeld document?
 
Zonder VBA is dit prima met VERT.ZOEKEN() op te lossen in een extra kolom.
 
Code voor je voorbeeld-bestand.
Code: 
Sub hsv()
Dim cl As Range, c As Range
For Each cl In Blad2.Columns(1).SpecialCells(2).Offset(1).SpecialCells(2)
  Set c = Blad1.Columns(1).Find(cl, , , xlWhole)
   If Not c Is Nothing Then
       c.Offset(, 2) = cl.Offset(, 1)
       cl.Offset(, 2) = "verwerkt"
     Else
       cl.Offset(, 2) = "niet gevonden"
   End If
 Next cl
End Sub
 
Bedankt Harry
ongelooflijk dat slechts 12 lijnen coding mij zoveel werk gaat besparen !
Toch nog een vraag : stel dat ik ook aankoopprijs op deze manier wil updaten ( dus in blad 2 staat dan de artikelnummer in kolom A en de prijs in kolom B
wat veranderd er dan aan de coding ?
 
Maak dan van de 2 een 3.
Code: 
c.Offset(, 2) = cl.Offset(, 1)
 
Bij 5000 lijnen misschien een snelheidswinst ?
Code: 
Sub tst()
sn = Blad2.Cells(1).CurrentRegion
sn2 = Blad1.Cells(1).CurrentRegion
For i = 1 To UBound(sn)
    For ii = 1 To UBound(sn2)
        If sn(i, 1) = sn2(ii, 1) Then
            sn2(ii, 3) = sn(i, 2): sn(i, 3) = "OK": Exit For
        Else
            sn(i, 3) = "niet gevonden"
        End If
    Next
Next
Blad1.Cells(1).CurrentRegion.Resize(UBound(sn2), UBound(sn2, 2)) = sn2
Blad2.Cells(1).CurrentRegion.Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

Voor de prijsaanpassing.
Code: 
sn2(ii, 4) = sn(i, 2): sn(i, 3) = "OK": Exit For
 
Laatst bewerkt:
Was ook mijn gedachte Rudi, maar het gaat niet om de 5000, maar om de 20 lijnen wat de kortste lus is.
 
Wellicht sneller omdat meer in het geheugen wordt gedaan:

Code: 
Sub M_snb()
    sn = Sheet2.Cells(1).CurrentRegion
    sp = Sheet1.Cells(1).CurrentRegion
    sq = Sheet1.Cells(1).CurrentRegion.Resize(, 1)
    
    On Error Resume Next
    For j = 2 To UBound(sn)
      sp(Application.Match(sn(j, 1), sq, 0), 3) = sn(j, 2)
    Next
    
    Sheet1.Cells(1).CurrentRegion = sp
End Sub
 
Laatst bewerkt:
Hij is weer mooi @snb.

"Wellicht" is ook goed omschreven, daar werkbladfuncties weer iets vertragen ( .find zal ook niet zo snel zijn vermoed ik), maar dat doet niets aan de code af.
 
@HSV

We zullen het eens testen: 20.000 keer .find vs. 20.000 keer .match
 
Maak jij de test?, dan bekijk ik het resultaat.
Je maakt me wel nieuwsgierig nu.
 
Inderdaad.
Onze zoekfuncties vertragen enorm.
Bedankt voor je inzet.
 
Harry, ik heb je oplossing van gisteren 18:49 successvol gebruik vandaag
maar ik heb nog een "probleem" voor mij ontdekt
In mijn voorbeeld van gisteren begonnen de gegevens in rijen/kolom A1
wat als nu de gegevens beginnen op bijvoorbeeld E10
Hoe moet die beginposistie in uw coding verwerkt worden ?
 
@marccram,

Upload een voorbeeldbestand voordat ik van alles hier neerzet.

@snb,
Tja, we moeten het er maar mee doen.
 
Test het maar eens.
Code: 
Sub hsv()
Dim cl As Range, c As Range
For Each cl In Blad2.Columns(1).SpecialCells(2).Offset(1).SpecialCells(2)
  Set c = Blad1.Columns(3).Find(cl, , , xlWhole)
   If Not c Is Nothing Then
       c.Offset(, 2) = cl.Offset(, 1)
       cl.Offset(, 2) = "verwerkt"
     Else
       cl.Offset(, 2) = "niet gevonden"
   End If
 Next cl
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan