2017-02-01 1 views
0

ist Ich versuche, eine Tabelle Teilmenge aus einer größeren Tabelle zu erstellen. Ich ziehe Daten aus bestimmten Spalten basierend auf Daten, die gefiltert werden, so dass alles bis zum Erreichen der ersten leeren Zeile kopiert und auf ein neues Blatt eingefügt wird. Im Idealfall möchte ich einen bestimmten Typ von formatierter Tabelle erstellen, aber im Moment versuche ich, das gleiche Format wie die Haupttabelle zu kopieren, aber Excel scheint sehr oft zu laufen und ich frage mich, ob es wegen Redundanzen ist.Mein Code verursacht Excel, um wirklich langsam zu laufen, ich frage mich, ob es wegen der unnötigen Schleifen

Sub Lists() 
Dim i As Integer 'define variables, i is a counter, K is a counter, c is an array to hold the values of column numbers to be coppied 
'Dim k As Integer ****this variable is no longer needed with this new code of including the formating 
'k = 2 'initialize value of counter k the value needed is 2 because the loop does not handle the first element, this is hard coded *** no longer needed with new formatting code 

Dim c As Variant 'this variable holds the column numbers to be copied 
c = Array(1, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 24, 25) 

Dim lNumElements As Long ' this varibale will hold the number of elements in array c 
lNumElements = UBound(c) - LBound(c) + 1 'this is a formula for the number of elemnts in variable c 

Dim NAME As String 
NAME = InputBox("Please name the sheet") 'here the user can choose the name of the new worksheet that they wish to write the new table to 

Dim ws As Worksheet 'declare a new worksheet to me made 
Set ws = ThisWorkbook.Sheets.Add(After:= _ 
     ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'code used to add a new work sheet 
ws.NAME = NAME 'use the name from the user input to rename the worksheet 

Worksheets("Database").Select 'select the database worksheet 
Worksheets("Database").Range("A1").Activate 'place the curser on the A1 range of database 

'Sheets("Database").Columns(1).Copy Destination:=Sheets(ws.NAME).Columns(1) ' copy from database sheet and paste to new sheet hard coded for column 1 as the for loop did not like having column one in it as well *** no longer needed with new code 
Sheets("Database").Columns(1).Copy 'copy the first column (column A) 
Worksheets(NAME).Select 'choose where you want to copy the data to on the new page 
Worksheets(NAME).Range("A1").Activate 'activate the section you choose to copy to in the previous line of code 
Selection.PasteSpecial Paste:=xlPasteValues 'paste the values of the code you wanted 
Selection.PasteSpecial Paste:=xlPasteFormats 'keep the formating of the code you pasted 



For i = 1 To lNumElements - 1 'this for loop will cycle through the number of elements in array c except for the first element 
'Sheets("Database").Columns(c(i)).Copy Destination:=Sheets(ws.NAME).Columns(k) ' copy from database sheet and paste to new sheet excluding element 1). Paste information starting in column 2 (column 1 is hard coded above) 

Worksheets("Database").Select 
Columns(c(i)).Activate 
Sheets("Database").Columns(c(i)).Copy 
Worksheets(NAME).Select 
Columns(i + 1).Activate 

Selection.PasteSpecial Paste:=xlPasteValues 
Selection.PasteSpecial Paste:=xlPasteFormats 

k = k + 1 
Next i 

End Sub 
+1

Sie könnten versuchen, zunächst nicht die ganze Spalten auswählen, sondern nur die Reichweite sind Sie interessiert sich auch. Vermeiden Sie "Auswählen" wann immer möglich. siehe http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros für Informationen. Mit diesen beiden Schritten beschleunigen Sie Ihr Makro wahrscheinlich um den Faktor zehn. –

+0

'ScreenUpdating = False' kann helfen. Aber zuerst, entfernen Sie einfach alle 'Select'- und' Activate'-Anweisungen. Wenn es aufgrund der Berechnung immer noch langsam ist, deaktivieren Sie die automatische Berechnung während der for-Schleife. – reasra

+0

@reasra aber wenn ich die select- und activate-Anweisungen entfernen muss, muss ich irgendwie noch die Daten kopieren und in das neue Blatt einfügen, ich habe noch nicht herausgefunden, wie man das mit anderem Code erledigt, der die Auswahl und Aktivierung nicht mit einbezieht Methode. – ThomasTcred

Antwort

0

die Sie interessieren und sehen, ob es hilft:

Disable Blatt Bildschirm

Application.ScreenUpdating = False 

‘Place your macro code here 

Application.ScreenUpdating = True 
+0

Hallo @Anand dies hilft, die Bildschirmbewegung hin und her zu reduzieren, aber es scheint noch eine Menge Verarbeitung zu erfordern, bevor der Code ausgeführt wird und ziemlich lange dauert, um ausgeführt zu werden. Trotzdem ist es immer noch eine Verbesserung im Vergleich. – ThomasTcred

0

aktualisieren Wenn Ihre Arbeitsmappe eine Menge Formeln oder Event-Makros, die es deutlich verlangsamen könnte. Versuchen Sie, die Magie vier:

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 
Application.Cursor = xlWait 

' Your code 

Application.Cursor = xlDefault 
Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 
Application.ScreenUpdating = True 
0

dies versuchen statt Kopie + Paste:

Worksheets(NAME).Activate 'Just to watch it happen 
For i = 1 To lNumElements - 1 
    Sheets(NAME).Columns(i + 1).Value = Sheets("Database").Columns(c(i)).Value 
    Sheets(NAME).Columns(i + 1).NumberFormat = Sheets("Database").Columns(c(i)).NumberFormat 
k = k + 1 
Next i 
Verwandte Themen