ich habe ein größeres Statistikprogramm gebastelt, da ziemlich viel code enthalten ist, habe ich den Code in mehrere Makros aufgeteilt. Starte ich alle Makros hintereinander läuft alles Fehlerfrei. Jetzt habe ich eine userform entworfen mit einigen Commandbuttons. Einer dieser Buttons startet alle Makros zur Berechnung der Daten. Jedoch stoppt der Code nun an einer Stelle welche definitiv nicht falsch sein kann, dies aber erst seit ich das Makro mittels CommandButton ausführe, starte ich dieses manuell geht es wieder ohne probleme.
Kann mir hier jemand helfen, ich weiß nicht weiter ...
Danke vorab,
Gruß
Andi
und hier der Code:
Private Sub CommandButton2_Click()
Call upfalse
' hier in übertragene_daten entsteht der fehler
Call uebertragene_daten_addieren_und_summieren
Call timeupdate
Dim ii As Integer, vv As Integer
Dim wss As Worksheet
Set wss = Sheets("fehler")
lasti = wss.Cells(65000, 1).End(xlUp).Row
If lasti = 1 Then lasti = 3
For i = 2 To lasti
If Not IsEmpty(wss.Cells(ii, 1)) Then
MsgBox ("Bitte Fehlerliste bearbeiten, Berechnung startet erst nach wenn diese Liste Fehlerfrei ist.")
Sheets("fehler").Select
uf_main.Hide
Exit Sub
End If
Next
Call korrigierte_fehlerliste_eintragen
Call suchen_ob_neuer_ada
Call statistik_aus_newprod_in_abg_stat_schreiben
Call timeupdate
Call uptrue
End Sub
Sub uebertragene_daten_addieren_und_summieren()
upfalse
Dim i As Integer, a As Integer, v As Integer, x As Integer, last As Integer, lastdaten As Integer
Dim str As String, nam As String, suchnam As String
Dim bew As Long
Dim st As Integer, ers As Integer
Dim upr As Integer, uv As Integer, ur As Integer, izv As Integer
Dim lv As Integer, sp As Integer, bu As Integer, riester As Integer
Dim zelle As Range
Dim prod As Worksheet, dat As Worksheet
Set dat = Sheets("daten")
Set prod = Sheets("newprod")
last = prod.Cells(5000, 1).End(xlUp).Row
lastdaten = Sheets("daten").Cells(50000, 1).End(xlUp).Row
'forschleife durchläuft alle ADAs
For i = 2 To last
nam = prod.Cells(i, 1) & " " & prod.Cells(i, 2)
'alle variablen auf null setzen
bew = 0
st = 0
ers = 0
upr = 0
uv = 0
ur = 0
izv = 0
riester = 0
bu = 0
sp = 0
For a = 2 To lastdaten
suchnam = dat.Cells(a, 1) & " " & dat.Cells(a, 2)
'vergleicht ada
If suchnam = nam Then
' addiert bewertung, filtert sparten mit Bewertungsmultiplikator
Select Case dat.Cells(a, 3)
Case Is = "LV"
bew = bew + (dat.Cells(a, 5) * 0.042)
Case Is = "KV"
bew = bew + (dat.Cells(a, 5) * 6)
Case Else
bew = bew + dat.Cells(a, 5)
End Select
'zählt kernsparten der ausschreibung
If dat.Cells(a, 6) = "N" Then
Select Case dat.Cells(a, 3)
Case Is = "UPR"
upr = upr + 1
Case Is = "UV"
uv = uv + 1
Case Is = "UR"
ur = ur + 1
Case Is = "IZV"
izv = izv + 1
Case Is = "LV"
' falls LV dann aufteilen nach art der lv
Select Case dat.Cells(a, 4)
Case Is = "RIESTER"
riester = riester + 1
Case Is = "BU-INVEST"
bu = bu + 1
Case Is = "STARTPOLICE"
sp = sp + 1
Case Else
End Select
Case Else
End Select
' bewertung und geförderte stücke zählen fertig
End If
' neugeschäftscounter
If dat.Cells(a, 6) = "N" Then
st = st + dat.Cells(a, 7)
Else
'ersatzgeschäftscounter
ers = ers + dat.Cells(a, 7)
End If
'daten in gesamt kopieren und übertragene daten löschen
dat.Rows(a).Copy
Sheets("gesamt").Cells(65000, 1).End(xlUp).Offset(1, 0).EntireRow.PasteSpecial
'hier stoppt der code, Laufzeitfehler 1004
'die clearcontents methode des rangeobjektes ist fehlerhaft
dat.Rows(a).ClearContents
End If
Next
' alle daten für ada summiert, eintragen in newprod
prod.Cells(i, 3) = prod.Cells(i, 3) + bew
prod.Cells(i, 4) = prod.Cells(i, 4) + st
prod.Cells(i, 5) = prod.Cells(i, 5) + bu
prod.Cells(i, 6) = prod.Cells(i, 6) + riester
prod.Cells(i, 7) = prod.Cells(i, 7) + sp
prod.Cells(i, 8) = prod.Cells(i, 8) + upr
prod.Cells(i, 9) = prod.Cells(i, 9) + uv
prod.Cells(i, 10) = prod.Cells(i, 10) + ur
prod.Cells(i, 11) = prod.Cells(i, 11) + izv
prod.Cells(i, 12) = prod.Cells(i, 12) + ers
'fertig, nächster ada
Next
'screenupdate = true
uptrue
End Sub