AW: Performance steigern
28.08.2014 13:48:53
Stefanie
Oh der ist ziemlich lang :)
Also solche If Anweisungen habe ich mehrere, da denke ich wäre es sinnvoll eine Funktion zu schreiben und die Variablen zu übergeben.
Aber auch die Schleifen sind sehr langsam.
Danke euch VG
Hier ein Ausschnitt:
If Inhalt = "XY" Then
index_P = 1
Columns.Find(What:=Inhalt, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).EntireColumn.Select
Selection.Copy
Sheets("Arbeitsblatt1").Activate
Sheets("Arbeitsblatt1").Select
'letzte Freie Spalte ermitteln
Cells(1, IIf(IsEmpty(Cells(1, Columns.Count)), _
Cells(1, Columns.Count).End(xlToLeft).Column, Columns.Count) + 1).Select
aktuelle_spalte = ActiveCell.EntireColumn.Column
ActiveSheet.Paste
Application.CutCopyMode = False
'Jetzt muss Asset noch umbenannt werden
Sheets("Arbeitsblatt2").Select
Cells(Q_Zeile, 4).Select
Selection.Copy
Sheets("Arbeitsblatt1").Select
Cells(1, aktuelle_spalte).Select
ActiveSheet.Paste
'Zellen einfärben
Cells(1, aktuelle_spalte).Interior.Color = RGB(255, 235, 156)
'Nun müssen diese noch in Risikobeurteilung eingetragen werden
Cells(1, aktuelle_spalte).Select
Bezeichnung = Cells(1, aktuelle_spalte).Value
'MsgBox Bezeichnung
Sheets("Arbeitsblatt1").Select
'Bereich = "H4:H49"
For Each Zelle In Range(Cells(4, aktuelle_spalte), Cells(49, aktuelle_spalte))
'Bereich muss auch noch variabel werden
'Range(cells(1,variable),cells(49,variable))
If Zelle.Value = "x" Then
Q_Zelle = "A" & Zeile_P
Range(Q_Zelle).Activate
Inhalt = ActiveCell.Value
Selection.Copy
Sheets("Arbeitsblatt3").Activate
Sheets("Arbeitsblatt3").Select
'Freie Zelle in Spalte B suchen und dort eintragen
b = Cells(Rows.Count, 2).End(xlUp).Row + 1
Cells(b, 2).Select
ActiveSheet.Paste
a = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(a, 1) = Bezeichnung
Sheets("Arbeitsblatt4").Select
If Cells(Zeile_P, 137).Value = "x" Then
Zeile_A = Zeile_P
'Merke dir die Zelle
Q_Zelle = "A" & Zeile_A
Range(Q_Zelle).Activate
Inhalt2 = ActiveCell.Value
'Gehe eine Zeile weiter
ActiveCell.Offset(0, 1).Select
For i = 2 To 20
For Each Zelle_X In Range(Cells(Zeile_A, i), Cells(Zeile_A, i))
Range(Cells(Zeile_A, i), Cells(Zeile_A, i)).Select
If Range(Cells(Zeile_A, i), Cells(Zeile_A, i)).Value = "x" Then
ActiveCell.EntireColumn.Select
x = ActiveCell.EntireColumn.Column
'MsgBox x
Cells(3, x).Select
Cells(3, x).Copy
Sheets("Arbeitsblatt3").Select _
Cells(b, y).Select
ActiveSheet.Paste
Cells(b, y).WrapText = True
ActiveSheet.Range("A4:ED" & x).Rows.EntireRow.AutoFit
Sheets("Arbeitsblatt4").Select
Cells(1, x).Select
Cells(1, x).Copy
Sheets("Arbeitsblatt3").Select
'Cells(4, IIf(IsEmpty(Cells(1, Columns.Count)), _
'Cells(4, Columns.Count).End(xlToLeft).Column, Columns.Count) _
+ 1).Select
'aktuelle_spalte_annex = ActiveCell.EntireColumn.Column
'Cells(b, aktuelle_spalte_annex).FormulaR1C1 = "Annex"
Cells(b, aa).Select
ActiveSheet.Paste
y = aa + 1
aa = y + 1
Sheets("Arbeitsblatt4").Select
End If
Next Zelle_X
Next i
y = 15
aa = 16
End If
End If
Zeile_P = Zeile_P + 1
Sheets("Gefährdungen").Select
Next Zelle
End If
End If