Datei zu groß Erfassung braucht fast 1 Minute!
05.01.2005 10:55:25
Stefane
ich habe in VBA ein Erfassungstool programmiert, das auch wunderbar funktioniert. Das Problem ist nur, dass der Erfassungsvorgang (nach Eintrag der Daten und Drücken des Buttons Erfassen) über eine Minute dauert, wenn bereits große Mengen an Datensätzen vorhanden sind. Ab 500 Datensätzen geht das Programm in die Knie. Unten stehend ist die dahinterliegende Formel. Kann mir jemand helfen? Wäre super, wenn das klappen würde!
Ciao
Stefane
Private Sub cmdErfassen_Click()
Dim lngNeueReihe As Long
Workbooks("Infrastruktur.xls").Worksheets("Straßeneinrichtungen").Activate
lngNeueReihe = Range("f2536").End(xlUp).Row + 1
'ActiveSheet.Cells(lngNeueReihe, 3).Value = txtAnlagennummer
ActiveSheet.Cells(lngNeueReihe, 4).Value = txtBeschreibung1
ActiveSheet.Cells(lngNeueReihe, 5).Value = txtBeschreibung2
ActiveSheet.Cells(lngNeueReihe, 6).Value = txtStandort
ActiveSheet.Cells(lngNeueReihe, 7).Value = cboAnlagenklasse
ActiveSheet.Cells(lngNeueReihe, 8).Value = cboAnlagensachgruppe
ActiveSheet.Cells(lngNeueReihe, 9).Value = cboKostenstelle
ActiveSheet.Cells(lngNeueReihe, 10).Value = cboProdukt
ActiveSheet.Cells(lngNeueReihe, 13).Value = txtSeriennummer
ActiveSheet.Cells(lngNeueReihe, 14).Value = cboAfaBuchcode
ActiveSheet.Cells(lngNeueReihe, 15).Value = cboAnlagenbuchungsgruppe
ActiveSheet.Cells(lngNeueReihe, 16).Value = cboKRAnlagenbuchungsgruppe
ActiveSheet.Cells(lngNeueReihe, 17).Value = cboAfaMethode
ActiveSheet.Cells(lngNeueReihe, 19).Value = txtNutzungsdauer
ActiveSheet.Cells(lngNeueReihe, 20).Value = cboVerzinsung
ActiveSheet.Cells(lngNeueReihe, 21).Value = cboEigenkapitalzinssatz
ActiveSheet.Cells(lngNeueReihe, 22).Value = cboRestwertbildung
ActiveSheet.Cells(lngNeueReihe, 24).Value = cboHauptanlageUnteranlage
ActiveSheet.Cells(lngNeueReihe, 39).Value = cboHauptanlagennummer
ActiveSheet.Cells(lngNeueReihe, 26).Value = txtReserve1
ActiveSheet.Cells(lngNeueReihe, 27).Value = txtReserve2
'ActiveSheet.Cells(lngNeueReihe, 28).Value = txtAnlagennummer
ActiveSheet.Cells(lngNeueReihe, 29).Value = txtAnlagedatum
ActiveSheet.Cells(lngNeueReihe, 30).Value = txtBelegnummer1
ActiveSheet.Cells(lngNeueReihe, 31).Value = txtBeschreibung3
ActiveSheet.Cells(lngNeueReihe, 32).Value = txtAnschaffungskosten
ActiveSheet.Cells(lngNeueReihe, 33).Value = cboAfaBuchcode
'ActiveSheet.Cells(lngNeueReihe, 34).Value = cboAnlageBuchungsart1
'ActiveSheet.Cells(lngNeueReihe, 35).Value = txtAnlagennummer
'ActiveSheet.Cells(lngNeueReihe, 36).Value = txtAnlagedatumAfa
'ActiveSheet.Cells(lngNeueReihe, 37).Value = txtBelegnummer2
'ActiveSheet.Cells(lngNeueReihe, 38).Value = txtBeschreibung4
'ActiveSheet.Cells(lngNeueReihe, 39).Value = txtAbschreibungsbetrag
'ActiveSheet.Cells(lngNeueReihe, 40).Value = cboAfaBuchcode
'ActiveSheet.Cells(lngNeueReihe, 41).Value = cboAnlageBuchungsart2
lngNeueReihe = Range("f2536").End(xlUp).Row
Cells(lngNeueReihe, 36).Activate
ActiveCell.Value = Cells(ActiveCell.Row, 38).Value
Application.EnableEvents = True
Unload Me
usrStraßeneinrichtungen.Show
End Sub