Hallo,
ich möchte aus einem File (WbDatei1; Sheet1), welches über 20000 Zeilen hat, wenn die Bedingungen stimmen div. Daten auslesen und in ein anderes File (WbDatei2; Sheet2) lesen. Das Sheet2 hat eine fixe Struktur und darf nicht verändert werden.
Im Sheet1 sind auch die Lieferzeiträume "von" und "bis" enthalten. Leider stimmen diese Daten nicht mit dem Abrechnungszeitraum überein. Deshalb wird über die UserForm das "DateFrom" und "DateTo" zusätzlich abgefragt und mit den Lieferzeiträumen aus Sheet1 verglichen.
Wenn die Bedingungen (pro Kunde) stimmen, werden die Daten in das Sheet2 gelesen. Kunde 1 Schweiz= Sheet2 Zeile 25-55, Kunde 1 Deutschland= Sheet2 Zeile 65 bis 95, Kunde 2 Schweiz=Sheet2 ab Zeile 105 usw.
Lieder erhalte ich folgende Meldung: Fehler beim Kompilieren: Prozedur zu gross
Wie kann ich das vereinfachen?
Nachfolgend findet ihr eine Code-Auszug:
Sub Fakturierungsbeleg()
Dim sPfad, sPfad1 As String ' der Ordner-Pfad der Excel-Mappen
Dim sDatei, sDatei1 As String ' die zu beschreibende Datei und zu speichernde Datei
Dim WbDatei1 As Workbook ' Quelle
Dim WbDatei2 As Workbook ' Ziel
Dim lngLZeile1, lngLZeile2 As Long
Dim DateFrom As Date ' Lieferdatum von
Dim DateTo As Date ' Lieferdatum bis
Dim MonthLieferung As String ' Monatsname vom Lieferdatum
Dim sLieferzeitraum As String
Dim strDateiname As String
Set WbDatei1 = ActiveWorkbook 'Quelle Sheet1
'Sprungmarke, falls das Datum fehlt oder falsch eingegeben wurde
Zurück_Datumeingabe_falsch:
UserForm1.TextBox1 = DateSerial(Year(Date), Month(Date) - 1, 1) 'ermitttelt ersten Tag vom Vormonat
UserForm1.TextBox2 = DateSerial(Year(Date), Month(Date), 1 - 1) 'ermittelt letzten Tag vom vormonat
UserForm1.Show 'Zeige die UserForm1 an
' Prüfung, ob in UserForm das Datum "Lieferzeitraum von" und Lieferzeitraum bis" eingegeben sind
If UserForm1.TextBox1 = "" Or UserForm1.TextBox2 = "" Then
MsgBox "Bitte Datum eingeben", vbInformation, "fehlendes Datum"
GoTo Zurück_Datumeingabe_falsch
End If
' Prüfung, ob in UserForm das Datum "Lieferzeitraum von" und Lieferzeitraum bis" im korrekten Format ist.
If Not IsDate(UserForm1.TextBox1) Or Not IsDate(UserForm1.TextBox2) Then
MsgBox "Datum hat falsches Format", vbInformation, "Bitte Datum prüfen"
GoTo Zurück_Datumeingabe_falsch
Else
DateFrom = UserForm1.TextBox1.Value
DateTo = UserForm1.TextBox2.Value
sPfad = "\\whh.loc\orga\"
sPfad1 = "C:\Users\Public\Documents\"
sDatei = "Template_Fakturierungsbelege.xlsm"
If Dir(sPfad & sDatei) <> "" Then
'Workbooks.Open (sPfad & sDatei)
Set WbDatei2 = Workbooks.Open(sPfad & sDatei)
'ThisWorkbook.Activate
'Application.ActiveWindow.Visible = False
Else
MsgBox "Den angegebenen Ordner """ & sPfad & """" & Chr(10) & _
"und/oder die gesuchte Datei """ & sDatei & """ gibt es nicht!", _
16, " Hinweis für " & Application.UserName
Exit Sub
End If
Application.ScreenUpdating = False
MonthLieferung = Format(DateTo, "mmmm")
sLieferzeitraum = Format(DateFrom, "dd.mm.yyyy") & " " & "bis" & " " & Format(DateTo, "dd.mm.yyyy")
strDateiname = Range("A1").Value & "_" & sLieferzeitraum ' Dateiname = Text aus Zelle A1 + Lieferzeitraum mit Datum von bis
Unload UserForm1
'letzte Zeile vom JReport ermitteln
WbDatei1.Activate
lngLZeile1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
WbDatei2.Sheets("Sheet2").Cells(3, 3).Value = sLieferzeitraum
WbDatei2.Sheets("Sheet2").Cells(4, 3).Value = Application.UserName ' Daten aufbereitet von
WbDatei2.Sheets("Sheet2").Cells(4, 7).Value = FileDateTime(ThisWorkbook.FullName) ' Zeitstempel
' ** ABFRAGE DER KUNDEN
' ** Kunde A: Schweiz
A = 25 ' Im Fakturierungsbeleg ab Zeile 25 die Werte reinschreiben
For i = 1 To lngLZeile1 ' lngLZeile1 ist die letzte Zeile vom JReport wo ein Eintrag ist
If WbDatei1.Sheets(1).Cells(i, 1) Like "Kunde_A_Schweiz*" Then
' Datumsprüfung "Lieferzeitraum von"
If WbDatei1.Sheets("Sheet1").Cells(i, 4).Value <= DateFrom Then
WbDatei2.Sheets("Sheet2").Cells(A, 4).Value = DateFrom
Else
WbDatei2.Sheets("Sheet2").Cells(A, 4).Value = WbDatei1.Sheets("Sheet1").Cells(i, 4).Value
End If
' Datumsprüfung "Lieferzeitraum bis"
If WbDatei1.Sheets("Sheet1").Cells(i, 5).Value >= DateTo Then
WbDatei2.Sheets("Sheet2").Cells(A, 5).Value = DateTo
Else
WbDatei2.Sheets("Sheet2").Cells(A, 5).Value = WbDatei1.Sheets("Sheet1").Cells(i, 5).Value
End If
' Abgabe Menge
WbDatei2.Sheets("Sheet2").Cells(A, 3).Value = WbDatei1.Sheets("Sheet1").Cells(i, 10).Value
' Betrag
WbDatei2.Sheets("Sheet2").Cells(A, 8).Value = WbDatei1.Sheets("Sheet1").Cells(i, 11).Value
' Liefermonat:
'WbDatei2.Sheets("Sheet2").Range("A25").Value = MonthLieferung
A = A + 1
End If
Next i
' ** Partner Kunde A: Deutschland
A = 65 ' Im Fakturierungsbeleg ab Zeile 65 die Werte reinschreiben
For i = 1 To lngLZeile1 ' lngLZeile1 ist die letzte Zeile vom JReport wo ein Eintrag ist
If WbDatei1.Sheets(1).Cells(i, 1) Like "Kunde_A_Deutschland*" Then
' Datumsprüfung "Lieferzeitraum von"
If WbDatei1.Sheets("Sheet1").Cells(i, 4).Value <= DateFrom Then
WbDatei2.Sheets("Sheet2").Cells(A, 4).Value = DateFrom
Else
WbDatei2.Sheets("Sheet2").Cells(A, 4).Value = WbDatei1.Sheets("Sheet1").Cells(i, 4).Value
End If
' Datumsprüfung "Lieferzeitraum bis"
If WbDatei1.Sheets("Sheet1").Cells(i, 5).Value >= DateTo Then
WbDatei2.Sheets("Sheet2").Cells(A, 5).Value = DateTo
Else
WbDatei2.Sheets("Sheet2").Cells(A, 5).Value = WbDatei1.Sheets("Sheet1").Cells(i, 5).Value
End If
' Abgabe Menge
WbDatei2.Sheets("Sheet2").Cells(A, 3).Value = WbDatei1.Sheets("Sheet1").Cells(i, 10).Value
' Betrag
WbDatei2.Sheets("Sheet2").Cells(A, 8).Value = WbDatei1.Sheets("Sheet1").Cells(i, 11).Value
' Liefermonat:
'WbDatei2.Sheets("Sheet2").Range("A65").Value = MonthLieferung
A = A + 1
End If
Next i
' ** Partner Kunde B: Schweiz
A = 105 ' Im Fakturierungsbeleg ab Zeile 105 die Werte reinschreiben
'.....gleicher Aufbau wie bei Kunde
Es sind insgesamt über 50 Kunden mit unterschiedlichen Ländern (Schweiz, Deutschland und allenfalls auch Frankreich) abzufragen.
Ich bedanke mich für eure Hilfe. Gruss, Andreas