Just nu i M3-nätverket
Jump to content

Minnesbehov


Hagalund

Recommended Posts

Jag framställer en sida med data som jag plockar ur en annan arbetsbok. Ibland kompletterar jag med VLOOKUP från en sida som finns tillsammans med den sida som jag skapar i en ny arbetsbok. Den nya sidan med data tar ca 4000 kB. Kopierar jag det som står där till en ny sida i en ny arbetsbok tar den 100 kB. Jag använder inga formler i cellerna på den nya sidan utan allt skapas med VBA-kod.

 

Jag kan inte begripa varför den skapade sidan tar 4000 kB medan samma data kopierad till annan sida tar 100kB.

 

Kan någon förklara orsaken för mig?

Link to comment
Share on other sites

Inte utan att se vad du skapat men en vild, och troligen korrekt, gissning är att Excel cachat upp fler celler än nödvändigt.

 

Excel håller hela tiden reda på vilken som är den sista cellen på ett blad. Detta värde, denna cell, bestämmer vilka cellers värde och format som ska sparas.

 

Ibland tappar Excel bort vilken cell det är, något man gör gör att cellen blir onödigt långt på bladet, och boken man sparar växer då snabbt i storlek.

 

Dvs kontrollera vilken cell som är sista cell enligt Excel via verktyget Gå till special -> sista cell.

Link to comment
Share on other sites

Jodå mycket riktigt så har Excel klipp till med 65001 när det jag behöver varierar men är 6000 rader som mest. Kan jag begränsa det hela på något sätt?

Link to comment
Share on other sites

Normala knepet är att manuellt leta reda på det som är sista cellen istället och radera alla rader och kolumner utanför denna.

 

Men samtidigt vore det bästa om problemet aldrig uppstår, dvs att det du gör inte orsakar Excel till att sätta sista cellen så långt bort.

 

 

Vilken sista cellen är borde du väl veta redan om du skapar hela bladet med VBA-kod?

Link to comment
Share on other sites

Så här ser koden ut.

 

Dim tot As Long
Sub Utsökning()
Dim FilNamn As Variant
Dim Bemanningsbok As Variant
Dim i As Integer, j As Integer, a As Integer, b As Integer, s As Integer, t As Integer
Dim FileNamnOnly As String
Dim Ändelse As String
Dim Tabell(5999, 19) As Variant
Dim Poster As Long
Dim Filer(299, 1) As String


Sheets("Start").Range("K19") = ""
Sheets("Start").Range("H13") = 0
Sheets("START").Columns("P:Q").ClearContents

Application.ScreenUpdating = False

Sheets("Transaktioner").Select
Range("A2:T6001").ClearContents
Range("A2:T6001").Interior.ColorIndex = xlNone

Bemanningsbok = ActiveWorkbook.Name

Poster = 0
s = 0
tot = 0
On Error GoTo FelÄndelse
   FilNamn = Application.GetOpenFilename(MultiSelect:=True)
       If IsArray(FilNamn) Then
           For i = LBound(FilNamn) To UBound(FilNamn)
               Workbooks.Open FilNamn(i)
               längd = Len(FilNamn(i))
               Ändelse = ""
                   For j = längd To (längd - 9) Step -1
                       If Mid(FilNamn(i), j, 1) = Application.PathSeparator Then
                           FileNamnOnly = Ändelse
                       End If
                       Ändelse = Mid(FilNamn(i), j, 1) & Ändelse
                   Next j
               Poster = 0
               For a = 0 To 499
                   If Range("Namn").Cells(a + 1) = "" Then Exit For
                       For b = 0 To 11
                           Tabell(Poster + a + b, 0) = Range("ID").Cells(a + 1)  'ID
                           Tabell(Poster + a + b, 1) = Range("Namn").Cells(a + 1)  'Medarbetare
                           Tabell(Poster + a + b, 2) = Range("Månadslön").Cells(a + 1)  'Månadslön
                           Tabell(Poster + a + b, 3) = Range("Roll").Cells(a + 1)  'Roll
                           If Range("Roll").Cells(a + 1) = "" Then
                               Filer(s, 1) = "Roller"
                           End If

                           Tabell(Poster + a + b, 4) = "" 'Rollgrupp
                           Tabell(Poster + a + b, 5) = Range("Kställe").Cells(a + 1) 'Kst
                           Tabell(Poster + a + b, 6) = "" 'Kst text
                           Tabell(Poster + a + b, 7) = "" 'VO text
                           Tabell(Poster + a + b, 8) = Range("Vtyp").Cells(a + 1)  'V-typ
                           Tabell(Poster + a + b, 9) = Range("Finans").Cells(a + 1) 'Finanskod


                           Tabell(Poster + a + b, 10) = Application.WorksheetFunction.VLookup(Range("Finans").Cells(a + 1), _
                           Sheets("Finanskoder").Range(Sheets("Finanskoder").Cells(3, 1), _
                           Sheets("Finanskoder").Cells(141, 2)), 2, False) 'Finanstext
                           Tabell(Poster + a + b, 11) = Sheets("Parametrar").Cells(32, b + 3)  'Period

                           Tabell(Poster + a + b, 12) = Range("FaktiskTjgrad").Cells(a + 1, b + 1)  'Nettobemanning
                           If Range("Inlånad").Cells(a + 1) = "Nej" And _
                               Range("Vtyp").Cells(a + 1) = 1001 Then _
                               Tabell(Poster + a + b, 12) = 0

                           If Range("Vtyp").Cells(a + 1) = 90911 Then _
                                  Tabell(Poster + a + b, 12) = 0

                           Tabell(Poster + a + b, 13) = Range("Anställningtjgrad").Cells(a + 1, b + 1)  'Tj-grad enl anställning
                           Tabell(Poster + a + b, 14) = Range("Cavdrag").Cells(a + 1, b + 1)  'C-avdrag
                           Tabell(Poster + a + b, 15) = Range("Långsjuk").Cells(a + 1, b + 1)  'Långtidssjuk
                           Tabell(Poster + a + b, 16) = Range("SA").Cells(a + 1, b + 1)  'SA
                           Tabell(Poster + a + b, 17) = Range("FP").Cells(a + 1, b + 1)  'FP
                           Tabell(Poster + a + b, 18) = Range("Inlånad").Cells(a + 1) 'In/Utlånad
                           Tabell(Poster + a + b, 19) = Range("Kommentar").Cells(a + 1) 'Kommentar
                       Next b

                       Poster = Poster + 11
                   Next a
                   Application.ScreenUpdating = False
                   Workbooks(Bemanningsbok).Activate
                   For c = 0 To Poster + a - 1
                       For b = 0 To 19
                           Sheets("Transaktioner").Cells(tot + c + 2, b + 1) = Tabell(c, 
                       Next b
                   Next c
                   tot = tot + Poster + a

                   Application.DisplayAlerts = False
                   Workbooks(Ändelse).Close
                   Filer(s, 0) = Ändelse
                   s = s + 1
           Next i

       Else
           MsgBox "Ingen fil valdes"
           Exit Sub
       End If
On Error GoTo 0
Call Komplettering
Sheets("START").Select
Range("I21").Select
MsgBox ("Körningen är klar")
Range("I26") = Date
Range("I27") = Time
Range("H29") = Application.UserName
Range("H13") = tot
       For t = 0 To s - 1
           Range("P13").Offset(t, 0) = Filer(t, 0)
           Range("Q13").Offset(t, 0) = Filer(t, 1)
       Next t
Sheets("Transaktioner").Select
Sheets("START").Select
Application.ScreenUpdating = True

Exit Sub
FelÄndelse:
       MsgBox "Felaktig filändelse  " & Ändelse
       ThisWorkbook.Close savechanges:=False

End Sub

Sub Komplettering()

For r = 2 To tot + 1
   If Sheets("Transaktioner").Cells(r, 1) = "" Then Exit For

       If Sheets("Transaktioner").Cells(r, 4) = "" Then
           Sheets("Transaktioner").Cells(r, 4) = "EJ IFYLLT"
           Sheets("Transaktioner").Cells(r, 4).Interior.ColorIndex = 6
           Sheets("Transaktioner").Cells(r, 5) = "EJ IFYLLT"
           Sheets("Transaktioner").Cells(r, 5).Interior.ColorIndex = 6
           Sheets("Start").Range("K19") = "EJ IFYLLDA ROLLER"
       Else
           Sheets("Transaktioner").Cells(r, 5) = Application.WorksheetFunction.VLookup(Sheets("Transaktioner").Cells(r, 4), _
           Sheets("Roller").Range(Sheets("Roller").Cells(1, 1), Sheets("Roller").Cells(50, 2)), 2, False)
       End If

       On Error GoTo FEL
       Sheets("Transaktioner").Cells(r, 7) = Application.WorksheetFunction.VLookup(Sheets("Transaktioner").Cells(r, 6), _
       Sheets("Kst (Dim1)").Range(Sheets("Kst (Dim1)").Cells(3, 1), Sheets("Kst (Dim1)").Cells(1150, 3)), 2, False)

       Sheets("Transaktioner").Cells(r, 8) = Application.WorksheetFunction.VLookup(Sheets("Transaktioner").Cells(r, 6), _
       Sheets("Kst (Dim1)").Range(Sheets("Kst (Dim1)").Cells(3, 1), Sheets("Kst (Dim1)").Cells(1150, 3)), 3, False)


Next r
Exit Sub
FEL:    MsgBox ("Kostnadställe " & Sheets("Transaktioner").Cells(r, 6) & " fattas i 'Kst (Dim1)'")
End Sub

Link to comment
Share on other sites

Jag lyckades lösa det så nu är minnesbehovet 600 kB istället för närmare 10 ggr mer. Jag tog bort den sida jag hade tidigare för utskriften och satte dit en ny med samma rubriker. Jag ändrade litet i koden (jag hade angett i en dimsats för stort utrymme i en tabell).

Tack för tipset.

Link to comment
Share on other sites

Jag lyckades lösa det så nu är minnesbehovet 600 kB istället för närmare 10 ggr mer. Jag tog bort den sida jag hade tidigare för utskriften och satte dit en ny med samma rubriker. Jag ändrade litet i koden (jag hade angett i en dimsats för stort utrymme i en tabell).

Tack för tipset.

 

Låter bra.

 

Ett tips... Ett mycket viktigt tips:

 

!BORT BORT BORT med kod lik:

Sheets("Blad1").Select
Range("a1") = 1

 

Skriv istället

With Sheets("Blad1")
.Range("a1") = 1
End With

 

eller

With Blad1 
.Range("A1") = 1
End With

 

Ett till tips, håll koll på böcker du öppnar:

set wBook = Workbooks.Open(FilNamn(i))

Använd denna variabel för att adressera boken.

ThisWorkbook är boken koden startats i för övrigt.

 

Skriva till blad. Om du har möjlighet, skriv en hel matris i ett svep. Mycket mycket snabbare än att skriva cell för cell. Exempelvis

		Dim myArr(1 To 10, 1 To 1) As Variant
Dim i As Integer
For i = 1 To 10
	myArr(i, 1) = i
Next i
Me.Range("a1:A10") = myArr

Området man skriver till måste bara vara lika stort som matrisen. Exakt lika stort samt stegas från 1.

Glöm inte heller Application.Screenupdating, stänga av denna snabbar upp alla operationer med arbetsbladet rejält.

Link to comment
Share on other sites

Jag fixade det hela genom att ta bort ett blad och sedan lägga till det igen så jag blev av med den gamla cachen. Jag inser nu att detta inte alltid är en så lyckad metod. Om man har många namn t ex så måste man göra om dem eftersom referensen försvinner "ett tag".

Jag undara därför om det finns något annat sätt än att byta ett blad för att bli av med en oönskad cachreservation?

Link to comment
Share on other sites

Testa att radera alla rader och kolumner som ska vara tomma. Det brukar lösa detta problem.

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.



×
×
  • Create New...