Just nu i M3-nätverket
Gå till innehåll

Långsam flytt av data


short

Rekommendera Poster

Jag har flera tillämpningar där arbetsböckerna redan är spridda bland ett större antal användare. Ibland uppstår behovet av att ändra i koden och/eller i viss design (alla designändringar går inte). Jag har då konstruerat ett flyttprogram som flyttar över den enskilde användarens inmatade data till den nya boken. Jag sänder ut ett flyttprogram och den nya arbetsboken som heter Till.xlsm. Användaren instrueras att öppna den äldre arbetsboken och kalla den Från.xlsm samt Till.xlsm och flyttprogrammet. Genom att trycka på en knapp i flyttprogrammet körs ett makro som kopierar från den gamla boken till den nya .

Windows(Frånnamn).Activate
    Sheets("Planeringsperiod").Range("C2").Copy
    Windows(Tillnamn).Activate
    Sheets("Planeringsperiod").Range("C2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Planeringsperiod").Protect BladLösen

Detta fungerar i regel alldeles utmärkt. Nu har jag dock stött på ett knepigt problem. I den aktuella arbetsboken är det över 2000 ggr som jag måste hoppa fram och tillbaka mellan böckerna eftersom inmatningsområdena inte hänger ihop. Tyvärr går det inte att definiera en range som består av flera områden och klippa (går bra) och klistra (går inte eftersom området inte hålls isär). Jag försökte med att läsa in alltsammans cell för cell i en tabell samt därifrån fylla i den nya arbetsboken men det tar ännu längre tid. Tacksam för tips som snabbar upp körningen.

Länk till kommentar
Dela på andra webbplatser

Ove Söderlund

Det här kan ju liknas vid att man gör en synkronisering och de tillämpningar jag har utvecklat och där det ska hanteras en större mängd data så jobbar jag med matriser samt stänger av skärmuppdatering om nödvändigt. Det som tar tid i ditt fall är vad jag förstår att du växlar mellan arbetsböckerna ett stort antal ggr. Detta blir speciellt krävande om filerna ligger på en nätverksenhet t.ex.

 

Du har inte möjlighet att tänka igenom vad koden gör, att låta den öppna Från-boken, läsa av alla värden och lagra i en matris, stänga Från-boken, öppna Till-boken och skriva in data från matrisen?

 

Jag noterar att den exempelkod du visar i ditt inlägg ser ut som den som skapas via Makroinspelaren, och den koden blir inte speciellt optimerad för större mängd iterationer. För optimering i VBA krävs i princip alltid att man kodar "för hand" alternativt skriver om den kod som genereras av Makroinspelaren.

Länk till kommentar
Dela på andra webbplatser

Två saker i koden ovan

1: Du behöver INTE aktivera boken du skriver till. Bort med den raden. går att skriva direkt till boken.

2: Snabba upp genom att ange

Application.Screenupdating = False

i början av koden

och, för god sed:

Application.Screenupdating = True

 

3: Går ALLTID snabbare att kopiera stora partier/matriser med data i ett svep än cell för cell, dvs ska du kopiera A1:A100, alla värden, kopiera hela referensen med en kodrad.

4: Om beräkningar baseras på cellerna du skriver till kan det vara en bra idé att slå av automatiska beräkningarna. Men se till att aktivera dem igen även! Även i vid eventuella fel.

 

5: Blad2.Range("A1").Value = Blad1.Range("A1").Value

är snabbare än Copy.

och Blad2.Range("A1:A1000").Value = Blad1.Range("C1:C1000").Value

går nästan lika snabbt som bara en cell.

 

Bra poänger även av Ove ovan.

Länk till kommentar
Dela på andra webbplatser

1. Ska jag göra

2. Gör jag redan

3. Så gör jag när jag kopierar och klistrar in. Exemplet var olyckligt eftersom de bara var en cell.

4. Jag stänger av Events men har inte prövat att stänga av beräkningar - ska pröva detta

5 Ska jag göra

 

Ove: Jag testade att läsa in allt i en matris och sedan byta fokus till att plocka in värdena. Problemet var att det gjordes cell för cell. Finns det ett sätt att läsa hela sjok av värden till en matris respektive från en matris?

Länk till kommentar
Dela på andra webbplatser

Om målormådet har exakt samma dimension som matrisen går det att skriva hela matrisen i ett svep.

 

Events behöver du bara stänga av om du har kod under events. (och där bör du inte ha kod).

Länk till kommentar
Dela på andra webbplatser

Ove Söderlund

Ove: Jag testade att läsa in allt i en matris och sedan byta fokus till att plocka in värdena. Problemet var att det gjordes cell för cell. Finns det ett sätt att läsa hela sjok av värden till en matris respektive från en matris?

 

Ett exempel att fylla data i en matris med ett cellområde:

arrValues = Range(Cells(2, 1), Cells(11, 3))

Matrisen arrValues dimensionerad som Variant och fylls med data från området A2 - C11.

 

Det går även så klart att använda For/Next-loopar för varje område du vill ha in i matrisen, Ska du ha in fler områden i samma matris får du använda ReDim Preserve.

 

Läsvärt om matriser:

Grundläggande information om matriser av Chip Pearson

Mer information från sajten VBA Programming Service där ovanstående kodexempel är hämtad ifrån.

Länk till kommentar
Dela på andra webbplatser

Jag har i timmar försökt få till det men icke... När ReDim satsen ska köras svarar datorn Utanför index. Jag försöker öka en tabell från 10 rader och tre kolumner till fyra kolumner utan att mista de redan inlästa uppgifterna-

Dim Tabell As Variant

    Tabell = Range(Cells(2, 1), Cells(11, 3))
    ReDim Preserve Tabell(10, UBound(Tabell, 2) + 1)
    Tabell = Range(Cells(2, 6), Cells(11, 6))

End Sub
Länk till kommentar
Dela på andra webbplatser

Arrayer är lite speciella. Du kan bara ändra dimension på den sista dimensionen och det gäller att du är korrekt i hur du anropar Redim.

 

När du skapar en Array med

Tabell = Range(cells(1,1), cells(2,2))

får du en

Array(1 to 2, 1 to 2)

så när du kör en redim på den får du skriva

ReDim Preserve Tabell(1 To 2, 1 To 3)

 

kinkigt värre..

Ingen riktig vinst heller att spara i array om du direkt kan kopiera mellan cellerna enligt formlerna jag gett ovan

Blad1.Range(A1:A100).Value = Blad2.Range("A1:A100).value

Länk till kommentar
Dela på andra webbplatser

1. Att man inte behöver aktivera boken man skriver till stämmer om det bara är en kolumn man ska kopiera. Ska man kopiera flera kolumner måste man aktivera boken man ska skriva till och då går inte heller din sats nr 5. (Se kodexempel)

Windows(Frånnamn).Activate    Sheets("Lönekostnader månadslön").Range(Range("LK_Aktivitet").Columns(2), Range("LK_Aktivitet").Columns(3)).Copy
    
    Windows(Tillnamn).Activate
    Sheets("Lönekostnader månadslön").Range(Range("LK_Aktivitet").Columns(2), Range("LK_Aktivitet").Columns(3)) _
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

4. Att stänga av formlerna under själva flytten och sedan sätta på den igen verkar ge en hel del.

Länk till kommentar
Dela på andra webbplatser


Sub nn() Dim Tabell As Variant Dim R As Long Dim C As LongTabell = Range(Cells(2, 6), Cells(10, 6))

 

Tabell = Range(Cells(2, 1), Cells(11, 3)) Debug.Print UBound(Tabell, 1); UBound(Tabell, 2) ReDim Preserve Tabell(1 To 10, 3 To 4) Tabell = Range(Cells(2, 6), Cells(10, 6)) Debug.Print UBound(Tabell, 1); UBound(Tabell, 2) For R = 1 To UBound(Tabell, 1) ' First array dimension is rows. For C = 1 To UBound(Tabell, 2) ' Second array dimension is columns. Debug.Print Tabell(R, C) Next C Next R End Sub

Första gången jag kör Debug.print ger det 10,3 vilket stämmer men andra gången ger det 9,1 det borde ge 10,4???? När jag skriver ut innehållet i Tabell så kommer bara sista raden med dvs cells(2,6) till Cells(10,6)

Länk till kommentar
Dela på andra webbplatser

Det går att stänga ner beräkningar också med:

Application.Calculation = xlCalculationManual

och återstarta med:

Application.Calculation = xlCalculationAutomatic

Kanske det du menar med att stänga ner formlerna.

 

 

Länk till kommentar
Dela på andra webbplatser

Sub nn()
Dim Tabell As Variant
Dim R As Long
Dim C As Long


    Tabell = Range(Cells(2, 1), Cells(11, 3))
    Debug.Print UBound(Tabell, 1); UBound(Tabell, 2)
    ReDim Preserve Tabell(1 To 10, 3 To 4)
    Tabell = Range(Cells(2, 6), Cells(10, 6))
    Debug.Print UBound(Tabell, 1); UBound(Tabell, 2)
    
    For R = 1 To UBound(Tabell, 1) ' First array dimension is rows.
    For C = 1 To UBound(Tabell, 2) ' Second array dimension is columns.
        Debug.Print Tabell(R, C)
    Next C
Next R

End Sub

Det blev väldigt konstigt så jag försöker igen. Vid första debug så blir Tabelldimensionerna 10,3 vilket  stämmer. Andra gången blir det 9,1 vilket borde vara 10,4 ????

När jag läser in det som ska stå i fjärde kolumnen så har det som fanns i de tre första kolumnerna försvunnit (de finns ju inte längre efter Redim

Länk till kommentar
Dela på andra webbplatser

1. Att man inte behöver aktivera boken man skriver till stämmer om det bara är en kolumn man ska kopiera. Ska man kopiera flera kolumner måste man aktivera boken man ska skriva till och då går inte heller din sats nr 5. (Se kodexempel)

Inte?

Sub test()
    Dim wsTarget As Worksheet
    Set wsTarget = Workbooks("Bok2").Sheets(1)
    Dim lsRows As Integer
    lsRows = Me.Range("A1").CurrentRegion.Rows.Count
    wsTarget.Range("A1").Resize(lsRows, 3).Value = Me.Range("A1").Resize(lsRows, 3).Value
End Sub

ReDim Preserve Tabell(1 To 10,1 To 4)

du ska ha med alla dimensioner nya tabellen ska ha, inte bara de nya!

Länk till kommentar
Dela på andra webbplatser

OK jag tror dig ska bara försöka begripa vad du gör (är inte så avancerad).

När man ReDim hur bär man sig åt för att addera ny information i det nya utrymmet?

Länk till kommentar
Dela på andra webbplatser

 Dim myArr() As Variant
    
    myArr = Range("A1:B10")
    Debug.Print UBound(myArr, 1) & ", " & UBound(myArr, 2)
    ReDim Preserve myArr(1 To UBound(myArr, 1), 1 To UBound(myArr, 2) + 2)
    Debug.Print UBound(myArr, 1) & ", " & UBound(myArr, 2)

fungerar.

 

likaså

    Dim myArr() As Variant
    
    ReDim myArr(2, 2)
    Debug.Print UBound(myArr, 1) & ", " & UBound(myArr, 2)
    ReDim Preserve myArr(2, 4)
    Debug.Print UBound(myArr, 1) & ", " & UBound(myArr, 2)

Helt enkelt, VBA har en ganska knäpp hanteringen av arrayer.

Exempel ett ger alltså en 1 to 2 array

Exempel två en 0 to 1  array som går enklare att utöka med fler värden.

Länk till kommentar
Dela på andra webbplatser

Jag fattar nu hur man utökar en Array samt hur man listar innehållet i den. Det jag fortfarande inte begriper det är att hur man skapar ett innehåll i en Array utöver Tabell=Range(Cells(1,1),Cells(2,2)) som är den superenkla inläsningen i början. Antag att det man då läst in är A1 tom B2. Efter utökningen av arrayen till 4 kolumner vill jag lägga till innehållet i E1 tom F2. Hur gör jag då om jag inte ska läsa in cell för cell i en for-next slinga? Jag vill ju samtidigt behålla A1 tom B2 (alltså Preserve). Hade jag vilja läsa in C1 tom D2 så vore det enkelt Tabell=Range(Cells(1,1),Cells(2,4)) men som sagt hur gör jag om fälten inte hänger ihop?

Länk till kommentar
Dela på andra webbplatser

Om du vill fylla en array med fler data måste du göra det post för post.

Det är enbart vid initialiseringen av en array som du kan göra tilldelning enligt

myArray = Range("A1:B10")

Om du gör det vid senare tillfälle skriver du helt enkelt över din array.

 

Poängen som kanske finns med att hantera data i en array är att arrayen kan samla ihop data som sedan kan skrivas i grupp på annat blad.

Säg exempelvis att du har data i 10 olika celler på bladet, du vill få ihop dessa i två kolumner om fem poster.

 

Då kan du stoppa in dessa värden i en array (stega med for eller liknande) och sedan skriva dem i ett svep till ditt nya blad.

 

Blad2.Range("A1:B5") = myArray

 

 

Ja, det kan tyckas vara att gå över ån för vatten men allt beror på hur du vill bygga din kod.

 

Jag tycker nog att du ska skippa arrayer. Min bästa lösning för flytt av data är i praktiken

1: Du har dina data utspridda på allsköns platser i boken

2: Du har en målbok där (delar av) data ska sparas i något med kondenserad form.

3: Du skapar ett utrymme i din bok där formler hämtar, samlar in, de data som är spridda i (1) i samma format som de ska exporteras i (2)

4: Du har kod som helt enkelt rakt av kopierar data från formlerna i punkt (3) till målet (2).

 

Mitt enkla mål är alltid att lägga så lite "smarthet" som möjligt i koden, låt Excel göra det Excel är bra på och låt VBA-koden komplettera när det inte räcker till.

 

 

men ett svar på din fråga, ett till. Ett annat sätt att hantera celler och data är att behandla dem som Range-objekt. Ett exempel:

set myRn = Range("a1:A10")

set myRn = Application.Union(myRn, Range("B1:B10"))

 

Fast att ta grannceller eller helt annan cell...

testa

set myRn = Application.Union(myRn, Range("J1:J10"))

och se om du kan få ut data ur den.

Tips: Titta på

For Each c in myRn.Areas

Länk till kommentar
Dela på andra webbplatser

Ove Söderlund
Jag vill inte påstå att nedanstående wall-of-text är en lösning på aktuell fråga, men kanske kan det ge en vägledning till lösning.

 

Jag utgår att dina användare har ett blad med definierade områden där data fylls i, i stil med ett formulär? Detta ger oss de "gränser"vi har att förhålla oss till.

 

Vi börjar med att bena upp problematiken.

 

Jag utgår i detta exempel att kalkylbladet har 3 olika områden som ska lagras i en matris. Områdena har olika antal rader och kolumner.

 

1: A1 - C3, 3 rader och 3 kolumner

2: A5 - F10, 6 rader och 6 kolumner

3: A12 - D12, 1 rad och 4 kolumner

 

Vi behöver först vilja vilken lösning vi vill använda. I detta exempel kan vi enkelt deklarera 3 olika matriser och snabbt skriva data, område 1 till matris 1 osv. Svagheten med denna lösning är om du har ett stort antal olika områden att det blir en större mängd matriser att hantera.

 

Vill du använda en enda matris behöver du dels veta största gränsen (området som har flest rader eller området som har flest kolumner) samt att du behöver någon form av avgränsning så att du vet vilken del av matrisen som ska till vilket område i nya boken. Matrisen dimensioneras så att antingen flest rader eller kolumner får vara övre gräns för första dimensionen, jag föreslår att kolumnerna får bestämma då data vanligtvis matas in radvis i ett kalkylark. Matrisens andra dimension utökas då allteftersom du matar in nya områdesdata.

 

Fast jag förslår gärna en tredje väg, att använda sig av en endimensionell matris, tänk här "Sekventiell fil". Du behöver för denna lösning en separat subrutin som du anropar med 4 värden, övre vänstra samt nedre högra koordinat för ett givet område samt en slutmarkör. Arbetsgången blir i stil med detta:

 

1. Deklarera en matris.

2. Call sub, skicka med områdets koordinater.

3. Deklarera en utökad matris, behålla befintlig data.

4. Skriva in värden, inkl koordinater och slutmarkör.

 

Exempelkod, har inte gjort någon avlusning så räkna med att fel kan finnas.



Option Explicit
Option Base 1

Dim arrMyArray()
Dim intAddedValues As Integer
Dim intCurrentArraySize As Integer ' Möjligen att datatypen Long kan behövas!
Dim R As Integer, C As Integer, A As Integer

Sub test()

Call AddToArray(1, 1, 3, 3) ' A1 - C3
Call AddToArray(5, 1, 10, 6) ' A5 - F10
Call AddToArray(12, 1, 12, 4) ' A12 - D12

End Sub

Sub AddToArray(row1, col1, row2, col2)

' Tar reda på matrisens nuvarande storlek
intCurrentArraySize = UBound(arrMyArray)

' Beräknar antal värden matrisen behöver utökas med (inkl. koordinater och slutvärde)
intAddedValues = (row2 - row1 + 1) * (col2 - col1 + 1) + 5

' Utökar matrisen (måste ta hänsyn till hur stor matrisen redan är och öka från detta värde)
ReDim Preserve arrMyArray(intCurrentArraySize + intAddedValues)

' Läser in data i matrisen

' Start- och slutkoordinater för området
arrMyArray(intCurrentArraySize + 1) = row1
arrMyArray(intCurrentArraySize + 2) = col1
arrMyArray(intCurrentArraySize + 3) = row2
arrMyArray(intCurrentArraySize + 4) = col2

A = 4 ' Ta hänsyn till att 4 värden redan lästs in i matrisen

' Läser in datat från aktuellt område
For R = row1 To row2
For C = col1 To col2
A = A + 1
arrMyArray(intCurrentArraySize + A) = Cells(R, C)
Next C
Next R

arrMyArray(intCurrentArraySize + A + 1) = "EndOfSeqence" 'Slutmarkör för aktuellt område

End Sub


 

För att läsa av värden och skriva in i nya kalkylbladet, bara att reversera subrutinen.

Slutmarkören går nog att utelämna, man har ju redan koordinaterna, men då måste man hela tiden ha en pekare som talar om var i matrisen ett nytt datasegment (område) börjar/slutar.

 

Hoppas ni förstår min tankegång, men det är nog så här jag hade löst TS aktuella problem. Jag tror att en sådan konstruktion ger en stor flexibilitet att anpassa för andra liknande uppgifter.

 

 

Länk till kommentar
Dela på andra webbplatser

Tack :thumbsup: för två ambitiösa svar. Jag ska testa de olika varianterna och återkommer med resultat om ett par dagar.

Monshi: Din bästa lösning i praktiken har jag faktiskt funderat på men synd bara att jag inte hade den innan jag spred ut arbetsböckerna. Man måste väl då ha två extra blad, ett med formler som kopierar inmatningen och ett som kan ta emot nya data för  att sedan behandlas av ett program som flyttar in data på "ordinarie" plats.

Länk till kommentar
Dela på andra webbplatser

Inte en aning om att det var så stor skillnad.

Jag gjorde ett test där samma Range() kopieras 1000 ggr, exakt denna kod tog 21". Utan

"Application.ScreenUpdating = False" och "Application.Calculation = xlCalculationManual" tog det 46" att köra samma kod.
 
Det andra kodexemplet tog 1-2" att köra, i exempel 2 är
"Sheets("Blad1").Activate
    Range("A1:A1000").Select
    Selection.Copy
    Sheets("Blad2").Activate
    Range("C1").Select
    ActiveSheet.Paste"
 
bytt till: 
 "Blad2.Range("A1:A1000") = Blad1.Range("A1:A1000").Value"
Sub KopieraTestCopyPaste()
Dim StartTid As String
Dim Stoptid As String
 
    Application.ScreenUpdating = False                  'Stänger av skärmuppdatering
    Application.Calculation = xlCalculationManual       'Stänger automatisk kalkylering
    
    StartTid = Time
    
    For i = 1 To 1000
    Sheets("Blad1").Activate
    Range("A1:A1000").Select
    Selection.Copy
    Sheets("Blad2").Activate
    Range("C1").Select
    ActiveSheet.Paste
    
    Next i
    
    Stoptid = Time
    
    Application.ScreenUpdating = True                   'Öppnar av skärmuppdatering
    Application.Calculation = xlCalculationAutomatic    'Öppnar automatisk kalkylering
    
    MsgBox "Starttid: " & StartTid & "  Stoptid: " & Stoptid
End Sub

 

 

 

Sub KopieraTestValue()

Dim StartTid As String
Dim Stoptid As String
 
    Application.ScreenUpdating = False                  'Stänger av skärmuppdatering
    Application.Calculation = xlCalculationManual       'Stänger automatisk kalkylering
    
    StartTid = Time
    For i = 1 To 1000
    Blad2.Range("A1:A1000") = Blad1.Range("A1:A1000").Value
    
    Next i
    
    Stoptid = Time
    
    Application.ScreenUpdating = True                   'Öppnar av skärmuppdatering
    Application.Calculation = xlCalculationAutomatic    'Öppnar automatisk kalkylering
    
    MsgBox "Starttid: " & StartTid & "  Stoptid: " & Stoptid
End Sub
 

 

Länk till kommentar
Dela på andra webbplatser

Det är skillnad Tune.

 

Men testa även att skriva om

Sheets("Blad1").Activate

    Range("A1:A1000").Select
    Selection.Copy
    Sheets("Blad2").Activate
    Range("C1").Select
    ActiveSheet.Paste"
 
till
Sheets("Blad1").Copy Sheets("Blad2").Range("C1")
 
eller
Sheets("Blad1").Copy
Sheets("Blad2").PasteSpecial xlPasteValues
 
torde spara lite tid
Länk till kommentar
Dela på andra webbplatser

Det konstiga är att "Sheets("Blad1").Range("A1:A1000").Copy Sheets("Blad2").Range("C1")"

tar längre tid än:

"For i = 1 To 1000

    Sheets("Blad1").Activate
    Range("A1:A1000").Select
    Selection.Copy
    Sheets("Blad2").Activate
    Range("C1").Select
    ActiveSheet.Paste
"
Ungefär dubbelt så lång tid (39" resp. 21").
 
Testade även att byta från vanliga referenser till Cells
"Range(Cells(rowindex,columnindex),Cells(rowindex,columnindex))"
Alltså:
Sheets("Blad1").Activate
        Range(Cells(1, 1), Cells(1000, 1)).Select
        Selection.Copy
        Sheets("Blad2").Activate
        Range(Cells(1, 3), Cells(1000, 3)).Select
        ActiveSheet.Paste
 
Körningen tog 14" , Cells är snabbare.
Länk till kommentar
Dela på andra webbplatser

Lustigt, man kan tycka att går man förbi clipboard, dvs Range.Copy Target, borde det går snabbare än det du gör.

Visserligen med Screenupdating = False så genererar Sheet.select och Sheet.Activate troligen ingen händelse, de raderna tordes mer eller mindre hoppas över.

 

Att Cells är snabbare är inte konstigt.

Range("A1") är en textreferens som måste översättas till Cells(1,1), slås upp i en lista någonstans.

 

Men jag hävdar ändå att

Sheets("Blad1").Range(Cells(1, 1), Cells(1000, 1)).Copy
Sheets("Blad2").Range(Cells(1, 3), Cells(1000, 3)).PasteSecial xlPasteAll
 
borde vara snabbare än alla dessa select och activate. Borde.
Ser snyggare ut i kod ivartfall.
 
Länk till kommentar
Dela på andra webbplatser

Jag är inte heller förvånad att Cells är snabbare, var inne på liknande fundering som du skrev.

Testade att ta bort  Application.ScreenUpdating = False och Application.Calculation = xlCalculationManual  och fortfarande Cells.

Då ökade körtiden från 14" till  32".  

Länk till kommentar
Dela på andra webbplatser

Nu har jag omarbetat flyttprogrammet och fått ned körtiden från 55 sek till 5 sek. Den största vinsten gav att stänga av den automatiska beräkningen (-37 sek). Sedan använde jag mig av Range().Value=Range().Value och tog bort aktiverandet av mottagarboken enl Monshis råd. När jag skulle flytta mer fler än en kolumn delade jag upp flytten och flyttade en kolumn i taget eftersom datorn nekade mig att ta flera kolumner i taget.

Windows(Frånnamn).Activate
        Sheets("Timplanering helår").Range(Range("TP_Aktivitet").Columns(kolumn + 5), Range("TP_Aktivitet").Columns(kolumn + 17)).Copy
        Windows(Tillnamn).Activate
        Sheets("Timplanering helår").Range(Range("TP_Aktivitet").Columns(kolumn + 5), Range("TP_Aktivitet").Columns(kolumn + 17)) _
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Detta delades upp i (endast kolumn 5 till 8 här i programmet 5 till 17)
        

Windows(Frånnamn).Activate
        Workbooks(Tillnamn).Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 5).Value = _
        Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 5).Value
        
        Workbooks(Tillnamn).Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 6).Value = _
        Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 6).Value
        
        Workbooks(Tillnamn).Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 7).Value = _
        Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 7).Value
        
        Workbooks(Tillnamn).Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 8).Value = _
        Sheets("Timplanering helår").Range("TP_Aktivitet").Columns(kolumn + 8).Value

Det senare gav -13 sek. Slutresultat 5 sek efter en minskning på 50 sek.

Array-lösningen trasslade jag mig in i så till den grad att jag gav upp. Jag har lärt mig mycket - tack för all hjälp.

Länk till kommentar
Dela på andra webbplatser

Arkiverat

Det här ämnet är nu arkiverat och är stängt för ytterligare svar.

×
×
  • Skapa nytt...