Macro is in office 2010 niet vooruit te branden

Status
Niet open voor verdere reacties.

Relleboer

Gebruiker
Lid geworden
6 okt 2006
Berichten
264
Code:
Sub Lijst_bewerken()
'Verwijder van waarden zonder Hp-code
Sheets(1).Cells(1, 1).EntireColumn.Delete
    For a = Sheets(1).Cells(1, 1).End(xlDown).Row To 1 Step -1
        
        If Sheets(1).Cells(a, 3) = "" Then Sheets(1).Cells(a, 3).EntireRow.Delete
    Next a
'Status van codes controleren
    Sheets(1).Cells(2, 12).FormulaR1C1 = _
    "=+IFERROR(VLOOKUP(RC[-9],'ABCK lijst'!C[-11]:C[-6],6,FALSE),"""")"
    Range("L2").AutoFill Destination:=Range(Cells(2, 12), Cells(2, 12).End(xlDown))
'Verwijderen van codes zonder status (half fabrikaten)
  
    For rij = Sheets(1).Cells(1, 1).End(xlDown).Row To 1 Step -1
    If Sheets(1).Cells(rij, 12).Value = "" Then Sheets(1).Cells(rij, 12).EntireRow.Delete
    Next rij

End Sub

Iemand enig idee waarom dit zelf met een data lijst van 200 regels een paar minuten duurt terwijl in office 2003 geen probleem en zo klaar
 
De oplossing

Ik heb het probleem gevonden. het zit hem in dit gedeelte.
Code:
"=+IFERROR(VLOOKUP(RC[-9],'ABCK lijst'!C[-11]:C[-6],6,FALSE),"""")"
    Range("L2").AutoFill Destination:=Range(Cells(2, 12), Cells(2, 12).End(xlDown))

Wedrom is gebleken dat de makkelijke weg vaak niet de goede is. Doordat hij de cellen gaat verwijderen die geen antwoord bevatten van bovenstaande code berekend hij alles opnieuw steeds. Nu maar gewoon weer een zoek functie geschreven.

Code:
For b = 1 To Sheets(1).Cells(1, 2).End(xlDown).Row Step 1
    With Worksheets(2).Range("a1:a6500")
    Set c = .Find(Cells(b, 3), LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Sheets(1).Cells(b, 12).Value = c.Offset(, 5).Value
            
            Set c = .FindNext(c)
          
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With
    Next
 
Dat kan simpeler:
Zeker als snelheid van belang is: hoe minder schrijfbewerkingen hoe beter
Code:
sub snb()
  On Error Resume Next
  With Sheets(1)
    .columns(3).specialcells(4).entirerow.delete

    sn = Sheets(2).Cells(1).Resize(6500, 6)
    sp = .Cells(1).CurrentRegion.Resize(, 3)
    st = .Cells(1).CurrentRegion.Columns(1)
  
    For j = 1 To UBound(sp)
      st(j, 1) = ""
      st(j, 1) = sn(Application.Match(sp(j, 3), Application.Index(sn, , 1), 0), 6)
    Next
  
    .Cells(1, 12).Resize(UBound(st)) = st

    .columns(12).specialcells(4).entirerow.delete
  end with
End sub
 
Laatst bewerkt:
Je kunt ook aan het begin van je macro de instelling voor automatisch berekenen ophalen, deze vervolgens op handmatig zetten en aan het einde van de macro weer terug zetten op wat het was. Zo weet je zeker dat er geen automatische berekeningen plaatsvinden. Bijvoorbeeld.

calc_setting = Application.Calculation
Application.Calculation = xlCalculationManual
.
.
.
Application.Calculation = calc_setting
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan