optimering af opdatering af range

Måske kunne du lige paste noget kode...

Har du sat Application.ScreenUpdate til false i starten af din makro og til true i slutningen?

ja.. det har jeg prøvet.. men det har ikke hjulpet det store.. jeg kan ikke så nemt paste noget kode, da det ligger på en bærbar, der ikke er på nettet.. men kan da lige skrive, hvordan jeg - kort sagt - har opbygget koden..


for t = 1 to xxx
  range([variabel bestemt af en masse kode] & t).value = "to do"
next

det er, hvad det kan koges ned til :d.. eller noget.. ej der er en del kode.. hvis jeg skrive det som en kommentar (med ' foran, går der ca. 2 sekunder, og så er den færdig...)... det er excel 2000, og jeg har microsoft mistænkt for at have lavet en seriøs bug.. jeg kan få den til at udskrive mange gange hurtigere ved den førnævnte esc + continue.. jeg har lige prøvet noget lignende (med en forlykke, der bruger range til at opdatere celler) med office xp, og der er der ikke så lang ventetid.. og det er en meget ældre, og langsommere computer.. er der ikke noget, man kan skrive eller en update, man kan hente, for at få det til at gå hurtigere??

Har du installeret SP3 til Office 2000?

nej.. det tror jeg ikke.. det er min fars arbejdscomp.. prøver lige at finde det, og teste det..

jeg kunne ikke lige få opdateringen til at virke.. den kunne ikke installeres.. tror det er fordi computeren er sikret i hoved og røv med kryptering af det ene og spærring af det andet, så man ikke kan gøre noget ved den, og den også kører ad helvede til.. men jeg prøver at finde ud af det, og vender tilbage med det..

Jeg har fået macroen over på min comp.. den er også langsom her.. jeg har følgende kode.. når jeg trykker på esc, kommer følgende skærmbillede op http://balder.frac.dk/window.JPG.. når jeg trykke continue, springer den hurtigt igennem scriptet.. der må være noget, jeg kan gøre..

Sub TOM_import()
    Dim starttime
    starttime = Now
    Dim alfabet
    alfabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    Dim t
    Dim startC 'start of Classification
    Dim endC 'end of Classification
    Dim startF 'start of Final Verdict
    Dim endF 'end of Final Verdict
    Dim count_write 'column-number to write to
    count_write = 3
    Dim count_read 'column-number to read from
    count_read = 4
    Dim a 'used for boolean expression ("yes"/"no")
    Dim finished '
    finished = 0
    Dim last_testcase 'the last testcase that has been written (in order to speed up the process)
   
    Range("A3:E1300").Value = ""
   
    Range("F3").Value = "Processing"
    Range("F4").Value = ""
    Application.run "rep_TOM"
   
    'Finds which rows Classification and Final Verdict starts and ends
    For t = 1 To 26
        If Sheets("TOM input").Range(Mid(alfabet, t, 1) & 1) = "Classification" And startC = "" Then
            startC = t
        End If
        If startF <> "" And Sheets("TOM input").Range(Mid(alfabet, t, 1) & 1) <> "" And endF = "" Then
            endF = t - 1
        End If
        If Sheets("TOM input").Range(Mid(alfabet, t, 1) & 1) = "Final Verdict" And startF = "" Then
            startF = t
            endC = t - 1
        End If
    Next
   
    Do While finished < 5
        a = "no"
        For t = startF To endF
                If (Sheets("TOM input").Range(Mid(alfabet, t, 1) & count_read) = "to do" Or Sheets("TOM input").Range(Mid(alfabet, t, 1) & count_read) = "retest") And Sheets("TOM input").Range(Mid(alfabet, endC - (endF - t), 1) & count_read) <> "P" And last_testcase <> Sheets("TOM input").Range("A" & count_read) Then
                    Select Case Sheets("TOM input").Range(Mid(alfabet, t, 1) & "3")
                        Case 900
                            Range("B" & count_write).Value = "to do"
                        Case 1800
                            Range("C" & count_write).Value = "to do"
                        Case 850
                            Range("D" & count_write).Value = "to do"
                        Case 1900
                            Range("E" & count_write).Value = "to do"
                    End Select
                    a = "yes"
                End If
        Next
       
        If a = "yes" Then 'if "to do" has been written
            Range("A" & count_write).Value = Sheets("TOM input").Range("A" & count_read)
            last_testcase = Sheets("TOM input").Range("A" & count_read)
            If Sheets("TOM input").Range(Mid(alfabet, startC, 1) & count_read) = "C1" Then
                If Range("E" & count_write) <> "" Then
                    Range("B" & count_write).Value = Replace(Range("B" & count_write), "to do", "main only")
                    Range("C" & count_write).Value = Replace(Range("C" & count_write), "to do", "main only")
                    Range("D" & count_write).Value = Replace(Range("D" & count_write), "to do", "main only")
                End If
                If Range("B" & count_write) <> "" Then
                    Range("C" & count_write).Value = Replace(Range("C" & count_write), "to do", "main only")
                    Range("D" & count_write).Value = Replace(Range("D" & count_write), "to do", "main only")
                End If
                If Range("C" & count_write) <> "" Then
                    Range("D" & count_write).Value = Replace(Range("D" & count_write), "to do", "main only")
                End If
            End If
            If Sheets("TOM input").Range(Mid(alfabet, startC, 1) & count_read) = "C3" Then
                If Sheets("TOM input").Range(Mid(alfabet, startF, 1) & 3) = "900" And Sheets("TOM input").Range(Mid(alfabet, startF + 1, 1) & 3) = "1800" And Sheets("TOM input").Range(Mid(alfabet, startF, 1) & count_read) = "to do" Then
                    Range("C" & count_write).Value = "main only"
                End If
                For t = startF To endF
                    If Sheets("TOM input").Range(Mid(alfabet, t, 1) & 3) = "850" And Sheets("TOM input").Range(Mid(alfabet, t + 1, 1) & 3) = "1900" And Sheets("TOM input").Range(Mid(alfabet, t, 1) & count_read) = "to do" Then
                        Range("E" & count_write).Value = "main only"
                    End If
                Next
            End If
            count_write = count_write + 1
        End If
        If Sheets("TOM input").Range("A" & count_read) = "" Then
            finished = finished + 1
        Else
            finished = 0
        End If
        count_read = count_read + 1
    Loop
    Range("F3").Value = "Done"
    Range("F4").Value = "It took " & (DateDiff("s", starttime, Now) - DateDiff("s", starttime, Now) Mod 60) / 60 & " minutes and " & DateDiff("s", starttime, Now) Mod 60 & " seconds"
End Sub

her fundet ud af, hvorfor det går så langsomt.. det er fordi 5200 Vlookup, der skal opdateres for hver For.. lukker dette spm. og opretter et andet, hvor målet er at venter med at opdatere med Vlookup.. http://eksperten.dk/spm/497189