VBA og status bar osv!

vi er vist nødt til at se den langsomme makro, for at vurdere.

det er bare en masse if sætninger...
'Clear this sheet before getting new data
    Sheets("XXXX").Select
    Cells.Select
    Selection.Clear
'Get data from original XXXX
    Sheets("XXXX").Select
    Range("B:B,C:C,D:D,H:H,N:N,O:O,X:X,Y:Y,AA:AA,AB:AB").Select
    Selection.Copy
    Sheets("XXXXX").Select
    Range("A:A").Select
    ActiveSheet.Paste
    Range("K10").Select
    ActiveCell.FormulaR1C1 = "SORT"
    Range("K11").Select


'Enter key values in SORT column for
   
    Do
        'Get criteriavalues
        boklcy = ActiveCell.Offset(0, -1).Value
        rptcod02 = ActiveCell.Offset(0, -3).Value
        rptcod01 = ActiveCell.Offset(0, -4).Value
        brprod = ActiveCell.Offset(0, -6).Value
        bracty = ActiveCell.Offset(0, -5).Value
        'Test and apply key value per row
        If boklcy = 0 Then
        ActiveCell.Value = "IGNORE"
        ElseIf 0 < rptcod02 And rptcod02 < 19999999 Then
            ActiveCell.Value = "PL INTEREST"
            ElseIf 19999999 < rptcod02 And rptcod02 < 29999999 Then
                ActiveCell.Value = "PL FEECOMM"
                ElseIf 29999999 < rptcod02 And rptcod02 < 34999999 Then
                    ActiveCell.Value = "PL FXTRAD"

----------------------------------------
Forsætter bare rigtigt langt endnu med ovenstående
----------------------------------------                 


        'Go to next row
        ActiveCell.Offset(1, 0).Select
        check1 = ActiveCell.Offset(0, -10).Value
    Loop Until IsEmpty(check1)

Du kan opnå en del,ved at tune din kode, f.eks. kan

Clear this sheet before getting new data
    Sheets("XXXX").Select
    Cells.Select
    Selection.Clear
'Get data from original XXXX
    Sheets("XXXX").Select
    Range("B:B,C:C,D:D,H:H,N:N,O:O,X:X,Y:Y,AA:AA,AB:AB").Select
    Selection.Copy
    Sheets("XXXXX").Select
    Range("A:A").Select
    ActiveSheet.Paste
    Range("K10").Select
    ActiveCell.FormulaR1C1 = "SORT"
    Range("K11").Select

laves om til

Clear this sheet before getting new data
    Sheets("XXXX").Clear
'Get data from original XXXX
    Sheets("XXXX").Range("B:B,C:C,D:D,H:H,N:N,O:O,X:X,Y:Y,AA:AA,AB:AB").Copy Sheets("XXXXX").Range("A:A")
    Sheets("XXXXX").Range("K10").FormulaR1C1 = "SORT"
    Range("K11").Select

Sheets("XXXX").Clear
skal være
Sheets("XXXX").Cells.Clear

? hvorfor? selve macroen virker fint, men den er bare utrolig langsom.... så jeg tænkte jeg ville lave en information (til mig selv) om hvor langt den var nået... kan jeg det?
- og tak for cells.clear (når jeg finder ud af hvad det gør :-) )

Den eneste måde, når du ikke kører i en løkke, er at sætte kaldet ind forskellige steder nedad i koden.
noget kode

UpdateStatusBar 10

mere kode

UpdateStatusBar 20

merekode


UpdateStatusBar 30

o.s.v.


Koden til statusbar
Public Sub UpdateStatusBar (PctDone)

Application.StatusBar = "Percent Completed: " & Format(PctDone, "0%")
end sub.

SUPER TAK! tryk du svar så skal du få dine points!

ok