AW: For Schleife - Performanceprobleme
11.05.2017 15:15:13
Daniel
Hi
probier mal das.
Sub Umformen()
Dim lZ As Long
Sheets("Ausgabe").Cells.Clear
'--- Kopfdaten übertragen (Spalte 1-4) ---
With Sheets("Prüfliste")
lZ = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:B" & lZ).Copy
End With
With Sheets("Ausgabe").Range("A2:E" & lZ)
.Cells(1, 1).PasteSpecial xlPasteValues
.Columns(3).Value = Now
.Columns(4).Value = "bydo@vba.ms"
.Columns(5).Value = "bydo"
End With
'--- inventarliste umgestalten ---
Sheets.Add after:=Sheets("Inventar")
ActiveSheet.Name = "Inventar2"
With Sheets("Inventar2")
Sheets("Inventar").UsedRange.Copy
.Cells(1, 1).PasteSpecial xlPasteAll
.Columns(3).Copy .Columns(4)
Sheets("Inventar").UsedRange.Offset(1, 0).Copy
.Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
.Columns(2).Copy
.Columns(5).Insert shift:=xlToRight
.Range("A:C").Delete
.UsedRange.Sort Key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
.Rows(2).Insert
.Cells(2, 1).Value = 0
End With
'--- Ergebnis Inventar eintragen
With Sheets("Ausgabe").Range("F2:I" & lZ)
.Columns(1).FormulaR1C1 = "=IF(VLOOKUP(RC2,Inventar2!C1,1,TRUE)=RC2," _
& "MATCH(RC2,Inventar2!C1,1),FALSE)"
.Columns(2).Resize(, 3).FormulaR1C1 = "=IF(NOT(RC6),""nicht gefunden""," _
& "IF(OR(INDEX(Inventar2!C4,RC6)=""aktiv""" _
& ",INDEX(Inventar2!C4,RC6)=""wartend""),""""," _
& "INDEX(Inventar2!C[-5],RC6)&""""))"
.Formula = .Value
.Columns(1).EntireColumn.Delete
End With
'-- Aufräumen
Application.DisplayAlerts = False
Sheets("Inventar2").Delete
Application.DisplayAlerts = True
With Sheets("Ausgabe")
.Columns(2).Delete
.Range("A1:D1").Value = Array("ZUGANG", "TIMESTAMP", "PRÜFERMAIL", "PRÜFER")
.Columns(2).AutoFit
.Select
End With
End Sub
Welche der Lösungsvarianten, die du erhalten hast, läuft denn mit deiner Datei besser?
Gruß Daniel