Makro mit Mod Operatoren

Hallo alle Zusammen,
ich habe folgendes Problem.
Bisher hatte ich ein Makro, welches mir wenn die Summe einer Zeile größer 0 ist die ganze Zeile kopiert und in ein bestimmtes Tabellenblatt einfügt. Sehr simpel und funktioniert natürlich nach wie vor.
Allerdings benötigt dieses Tabellenblatt nicht alle Informationen von der Zeile und daher habe ich bis jetzt genau diese Spalten löschen lassen (Union der Spalten und dann ein Delete Befehl). Nicht schick aber hat seinen Zweck erfüllt und die Laufzeit war noch ok.
Jetzt hat sich allerdings meine Excel etwas vergrößert und es gibt deutlich mehr Informationen, welche gelöscht werden müssen. Die Laufzeit ist mittlerweile so lange, dass ich das Makro immer vorher abgebrochen habe.
Das Makro heißt "Import for HC-Tool".
Ich habe ein zweites Makro "Import for GPS", welches eine ähnliche Aufgabe erfüllt und über Mod Operatoren nur die relevanten Zellen kopiert und daher keine Löschvorgänge erfordert.
Meine Versuche dieses umzubauen scheiterten und daher kann ich mein "Import for HC-Tool" Makro nicht mehr nutzen.
Anbei meine beiden Excel Verionen:
Sample_alt:
https://www.herber.de/bbs/user/118999.xlsm
Ziel: Überträgt die ganze Zeile und löscht alle Spalten wo keine monatlichen Headcounts stehen
In der Version funktionierendes "Import for HC-Tool" Makro (zum verstehen, was es macht und welche Spalten ich brauche.
Sample_aktuell:
https://www.herber.de/bbs/user/119001.xlsm
Ziel überträgt von der entsprechenden Zeile nur die relevanten Spalten, habe diese gelb eingefärbt (kein löschen erforderlich).
Aktuell übertrage ich einfach alles und sämtliche Löschversuche dauern eine Ewigkeit.
Am Besten Teile vom "Import for GPS" Makro verwenden, das Umbauen von Mods ist mir leider nicht gelungen.
Würde mich sehr freuen, wenn Jemand das Know-How hat eine gute Lösung zu erstellen.
Vielen Dank schon mal und viele Grüße
Felix

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Import_For_GPS() Dim zeile As Long Dim letzte As Long Dim anzjahre As Long Dim anzeintrag As Long Dim indziel As Long Dim intSpalte As Integer Dim werte() Dim auswertung() Dim daten Dim quelle As Object Dim ziel As Object Dim i As Long Dim start As Long Dim jahr As Long Dim spaltevar As Long Dim j As Long Dim DateiName As String Dim x As Integer Dim y As Integer Dim spalte As Long Application.ScreenUpdating = False Set quelle = ActiveSheet Set ziel = Worksheets("Transfer for HC-Tool") anzjahre = 7 letzte = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row anzeintrag = Application.WorksheetFunction.CountIf(quelle.Range("H19:H" & letzte), ">0") - 2 ReDim auswertung(1 To anzeintrag, 1 To anzjahre * 4 + 6) ReDim werte(3, anzjahre * 4) daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(letzte, 8 + 21 * anzjahre)) start = 19 indziel = 1 For zeile = start To start + anzeintrag - 1 auswertung(indziel, 1) = daten(zeile, 1) spalte = 9 For i = 1 To 4 * anzjahre auswertung(indziel, 3 + i) = daten(zeile, spalte) If i Mod 3 = 0 Then spalte = spalte + 4 Else spalte = spalte + 2 End If If i Mod 12 = 0 Then spalte = spalte + 1 Next i indziel = indziel + 1 Next 'ergebnisse zurückschreiben ziel.Range(ziel.Cells(9, 4), ziel.Cells(9 + anzeintrag - 1, anzjahre * 4 + 6)) = auswertung Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread