Laufzeit Verbessern
11.11.2016 13:09:42
Jonas
ich habe folgendes Anliegen:
Ich hab ein Arbeitsblatt "Gesamt", in dem in ca 300 Zeile in einer Spalte Verschiedene Namen Stehen (wiederholend)
Beipiel:
Nun stehen in dem Arbeitsblatt "ZOLL" alle Namen einmal.
Beispiel 2:
Mein makro soll nun "Gesamt" durchgehen und jede Zeile unter den entsprechenden Namen in "Zoll" kopieren.
Ein Freund von mir hat auf die schnelle folgende Zeilen geschrieben:
Fragen:
a.) Es wir jetzt jede Zeile direkt nach der Titelzeile eingefügt. Kann man statdessen die nächste freie Zeile auswählen, sodass die neue Zeile immer unter der davor kopierten steht?
b.) Ausserdem hat das ganze eine tierisch lange laufzeit, kann man das irgendwie verbessern? Dachte schon daran nicht alle zellen einzeln zu kopieren sondern die ganze Zeile?
Vielen Dank für die Hilfe!
Sub Zoll()
Dim i As Long
For i = 1 To 300
' Wir holen den Zellinhalt aus Blatt "Gesamt", Spalte D, Zeile i
ThisName = Range("Gesamt!C" & i)
' Nur weitermachen, falls ein Name gefunden wurde in der Zeile i, Range("A4:H4").Select
If Not (ThisName = "" Or ThisName = "Mitarbeiter") Then
Datum = Range("Gesamt!A" & i)
Objekt = Range("Gesamt!B" & i)
Mitarbeiter = Range("Gesamt!C" & i)
UmsatzH = Range("Gesamt!D" & i)
Arbeitszeit = Range("Gesamt!E" & i)
UmsatzTag = Range("Gesamt!F" & i)
LohnH = Range("Gesamt!G" & i)
LohnTag = Range("Gesamt!H" & i)
' Wir haben die Mitarbeiterdaten
' --> Jetzt in Zolldatenblatt Übertragen
' Wir suchen, an welcher Stelle der Mitarbeiter "ThisName" steht im Datenblatt " _
ZOLL"
Set rng1 = Range("ZOLL!B:B").Find(ThisName, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
' Wir haben etwas gefunden!
CorrectRow = Range("ZOLL!" & rng1.Address(0, 0)).Offset(2, -1).Address
Range("ZOLL!" & CorrectRow).EntireRow.Insert
Range("ZOLL!" & CorrectRow).Value = Datum
Range("ZOLL!" & CorrectRow).Offset(0, 1).Value = Objekt
Range("ZOLL!" & CorrectRow).Offset(0, 2).Value = Mitarbeiter
Range("ZOLL!" & CorrectRow).Offset(0, 3).Value = UmsatzH
Range("ZOLL!" & CorrectRow).Offset(0, 4).Value = Arbeitszeit
Range("ZOLL!" & CorrectRow).Offset(0, 5).Value = UmsatzTag
Range("ZOLL!" & CorrectRow).Offset(0, 6).Value = LohnH
Range("ZOLL!" & CorrectRow).Offset(0, 7).Value = LohnTag
Else
' Mitarbeiter taucht im Zoll nicht auf!
MsgBox "Fehler: Mitarbeiter " & ThisName & " taucht nicht in ZOLL auf!", _
vbCritical
End If
End If
Next i
End Sub