Hilfe Code beschleunigen

Guten Abend
Ich füge mit folgendem Code Daten in meine Tabelle :
Set wksQ = ThisWorkbook.Worksheets("Daten")
Set wksZ = ThisWorkbook.Worksheets("Neu")
Letzte1 = ThisWorkbook.Worksheets("Daten").Cells(Rows.Count, "A").End(xlUp).Row
Letzte2 = ThisWorkbook.Worksheets("Neu").Cells(Rows.Count, "A").End(xlUp).Row
For Q_x = 2 To Letzte1
If wksQ.Cells(Q_x, 7) = "x" Then
Artikel = wksQ.Cells(Q_x, 3)
Menge = wksQ.Cells(Q_x, 8)
Woche = wksQ.Cells(Q_x, 5)
For Z_X = 3 To Letzte2
If wksZ.Cells(Z_X, 3) = Artikel Then
MyRow = Z_X
For x = 7 To 143
If wksZ.Cells(3, x) = Woche Then
MyCol = x
If wksZ.Cells(MyRow, x) = "" Then
wksZ.Cells(MyRow, MyCol) = Menge
End If
End If
Next
End If
Next
End If
Next
Dies dauert allerdings bei 143 Spalten sehr lange.
Habt ihr eine Idee wie ich das ganze schneller gestalten kann ?
Viele Grüße
Der Manni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
so vielleicht schneller.
der Code erwartet, dass alle Artikelnummern und Wochen vorhanden sind.
Hier findet keine Prüfung statt.

Sub test()
Dim x As Long
Dim wksZ As Worksheet
Dim wksQ As Worksheet
Dim Ze_Art As Object
Dim Sp_Wo As Object
Set wksQ = ThisWorkbook.Worksheets("Daten")
Set wksZ = ThisWorkbook.Worksheets("Neu")
Set Ze_Art = CreateObject("scripting.dictionary")
Set Sp_Wo = CreateObject("scripting.dictionary")
For x = 7 To 143
Sp_Wo(wksZ.Cells(3, x)) = x
Next
For x = 3 To wksZ.Cells(Rows.Count, 1).End(xlUp).Row
Ze_Art(wksZ.Cells(x, 3)) = x
Next
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With wksQ
For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
With wksZ.Cells(Ze_Art(.Cells(x, 3)), Sp_Wo(.Cells(x, 5)))
If .Value = "" Then .Value = wksQ.Cells(x, 5)
End With
Next
End With
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

mangels konkreter Beispieldatei nicht getestet
Gruß Daniel

Option Explicit Sub Find_mehrmals() '* H. Ziplies * '* 29.03.2020 * '* erstellt von HajoZiplies@WEB.de Spam * '* http://Hajo-Excel.de Dim Rafound As Range Dim StAdresse As String With Worksheets("Projekte") Set Rafound = .Columns(4).find("Ha", .Range("D1"), , xlPart, , xlNext) ' xlPart enthalten ' xlWhole kompletter Vergleich If Not Rafound Is Nothing Then MsgBox Rafound.Address StAdresse = Rafound.Address ' erste Adresse merken Do ' Such wiederholen Set Rafound = .Columns(4).FindNext(Rafound) If Not Rafound Is Nothing Then If StAdresse = Rafound.Address Then Exit Do ' erstes Ergebniszelle Else MsgBox Rafound.Address End If End If Loop End If End With Set Rafound = 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