Begriffe gegen Zahlen austauschen zu langsam
VolkerM
mit folgenden Code werden Begriffe in einem Bereich abgefragt und gegen hinterlegte Zahlen ausgetauscht:
Private Sub Wertigkeit()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Dim rng As Range, rngCell As Range
Dim fct As WorksheetFunction
Dim var As Variant
Set rng = Sheets("Index").UsedRange
Set fct = WorksheetFunction
For Each rngCell In rng.Cells
If Not IsEmpty(rngCell) And fct.CountIf(rng, rngCell.Value) > 0 Then
var = Application.Match(rngCell.Value, Sheets("Daten").Columns(2), 0)
If Not IsError(var) Then
rngCell.Value = Sheets("Daten").Cells(var, 8).Value
End If
End If
Next rngCell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.Calculate
End With
End Sub
Beispieldatei: https://www.herber.de/bbs/user/71294.xlsm
Im Blatt Daten beträgt die Anzahl der Begriffe ca. 1200.
Die Begriffe im Blatt Index stehen ab Spalte 3 untereinander und bis zu 25 in einer Zeile.
Insgesamt sind ca. 2500 Zeilen und sehr viele Leerzellen vorhanden
Der Code läuft zwar, aber es dauert unendlich lange.
Kann man den Code beschleunigen, oder einen schnelleren nutzen ?
Vielen Dank im Voraus.
Gruß Volker