Code beschleunigen

Hallo Zusammen und allen noch einen schönen Sonntagabend!
Ich hoffe, dass man anhand des Codes welchen ich gleich einfüge erkennen kann, wie er zu beschleunigen ist. Nach meiner Uhr, läuft der Code 35 Sekunden, dass geht doch bestimmt schneller.
Hab ich selbst gebastelt und bin schon froh, dass er macht was er soll, nur halt extrem langsam!
Weiss jemand Rat? Bin wie immer für jede Hilfe dankbar!
Application.ScreenUpdating = False
For lng = 9 To 217
For lng1 = 3 To 92
For i = 5 To 17
If Sheets("Südamerika").Cells(lng, 4) = Sheets("Südamerika").Cells(lng1, 109) Then
Sheets("Südamerika").Cells(lng, i) = Sheets("Südamerika").Cells(lng1, i + 105)
End If
Next i
Next lng1
Next lng
For lng = 8 To 222
For lng1 = 2 To 198
For i = 25 To 34
If Sheets("Südamerika").Cells(lng, 22) = Sheets("Südamerika").Cells(lng1, 135) And Sheets("Südamerika").Cells(lng, 22) "" Then
Sheets("Südamerika").Cells(lng, i) = Sheets("Südamerika").Cells(lng1, i + 112)
End If
Next i
Next lng1
Next lng
Range("E5").Select
Application.ScreenUpdating = True
Gruß Frank H.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim myArr() As Variant ' eindimensionales Array A1:A20 With objWks myArr = Application.Transpose(.Range(.Cells(1, 1), .Cells(20, 1))) End With ' eindimensionales Array beginnend mit A2 With ThisWorkbook.Worksheets("Tabelle1") myArr = Application.Transpose(.Range(.[A2], .Cells(Rows.Count, "A").End(xlUp))) End With ' oder auch ' eindimensionales Array beginnend mit D3 With ThisWorkbook.Worksheets("Tabelle1") myArr = Application.Transpose(.Range(.Cells(3, 4), .Cells(Rows.Count, "D").End(xlUp))) End With

Hi
anstelle deines VBA-Codes kannst du auch den SVerweis bzw eine Kombi aus Index und Vergleich in die Zellen schreiben.
da du diese Formel dann ohne Schleife in alle Zellen gleichzeitig schreiben kannst, ist das schneller als jede Zelle einzeln zu beschreiben.
du mehrere Spalten mit dem gleichen Suchwert hast, würde ich erstmal die Zeilennummer der Fundstelle in einer Hilfsspalte ablegen, damit du diesen Wert mehrfach verwenden kannst, ohne dass er jedes mal neu berechnet werden muss.
anstelle der ersten drei schleifen so:
1. die Hilfsspalte in Spalte 18 (fall diese nicht frei ist, eine andere)
Formel in R9:R217: =Vergleich(D9;$DE$3:$DE$92;0)
2. um die Werte auszulesen:
Formel in E9:Q217: =Wenn(IstFehler(R9);"";Index(DF$3:DF$92;R9;1))
3. die Formel in E9:Q217 kopieren und als Wert einfügen, dann die Hilfsspalte löschen.
sieht als Code dann so aus:

Range("R9:R217").FormulaLocal = "=Vergleich(D9;$DE$3:$DE$92;0)"
With Range("E9:Q217")
.FormulaLocal = "=Wenn(IstFehler(R9);"";Index(DF$3:DF$92;R9;1))"
.Formula = .value
end with
Range("R9:R217").ClearContents

für den zweiten Schleifenblock dann anlog mit entsprechend geänderten Bezügen und der zusätzlichen WENN-Abfrage.
Gruß Daniel

For lng = 8 to 222 if Sheets("Südamerika").Cells(lng, 22) "" then for lng1 = 2 to 198 If Sheets("Südamerika").Cells(lng, 22) = Sheets("Südamerika").Cells(lng1, 135) for i = 25 to 34 Sheets("Südamerika").Cells(lng, i) = Sheets("Südamerika").Cells(lng1, i + _ 112) Next end if Next end if Next

Sub ddd() Dim WS As Worksheet, RNG As Range, VNT As Variant Dim lng As Long, lng1 As Long, i As Long Set WS = Worksheets("Südamerika") Set RNG = WS.Cells(2, 1).Resize(221, 146) VNT = RNG.Value For lng = 8 To 216 For lng1 = 2 To 91 If VNT(lng, 4) = VNT(lng1, 109) Then For i = 5 To 17 VNT(lng, i) = VNT(lng1, i + 105) Next i End If Next lng1 Next lng For lng = 7 To 221 If VNT(lng, 22) "" Then For lng1 = 1 To 197 If VNT(lng, 22) = VNT(lng1, 135) Then For i = 25 To 34 VNT(lng, i) = VNT(lng1, i + 112) Next i End If Next lng1 End If Next lng RNG.Value = VNT Erase VNT Set RNG = Nothing Set WS = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread