|
'Hi, ich habe mir trotzdem mal die Mühe gemacht, diesen Wirrwarr zu 'entwursten', und den Code gleichmal etwas optimiert.
'Kannst Du so markieren, kopieren und im VBA Editor einfügen. Ich konnte natürlich nur visuell checken, da mir deine Worksheets nicht vorliegen.
'Ich hoffe das mir kein Grammatikfehler 'durch die Augen geschlüpft' ist.
>>> Gib dann mal bitte ein Feedback <<<
Sub Rechnung()
Dim ABC, A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z As Integer 'Zähler ?????????
Dim Quelle As String 'Variable fuer Worksheet 1
Dim Ziel, fallig, zahlein As String 'Variable fuer Ziel Worksheet
Dim currentDate, datum As Date
'===========================================================================================> Definition der Sheets welche durchforstet werden
' Rows("2:801").delete 'Variable für Zeile "Z"; Beschriftung startet in Zeile 3 Z = 2
'===========================================================================================> Quellen durchlaufen
Anzahl_Quellen = 6 'Hier nur die Anzahl der Quellen angeben: In deinem Beispiel sind es 6 definierte Quellen
Ziel = "Forderungsübersicht"
For zähler = 1 To Anzahl_Quellen 'Da sich ansonsten in der Routine alles wiederholt, kann man es wunderbar mit einer For/Next-Schleife erschlagen.
Quelle = "A" + Trim(Str(zähler)) 'So wird bei jedem Durchlauf durch den Zähler die Quelle angepasst: "A" + "1" = "A1" >>> "A" + "2" = "A2" ... usw
'man kann eine Menge Code einsparen !
For A = 1 To 150
C = Worksheets(Quelle).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle).Cells(A, 16).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle).Cells(A, 8).Value
ElseIf Worksheets(Quelle).Cells(A, 16).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle).Cells(A, 16).Value
Z = Z + 1
End If
Next A
Next zähler
'===========================================================================================> RestCode abarbeiten ===> Datum & Betrag Check!
P = 0 'P werden die Summe von allen offenen Beträgen
Q = 0 'Q wird die Summe von allen offenen und fälligen Beträgen
For D = 2 To Z
datum = Worksheets(Ziel).Cells(D, 6).Value
fallig = Worksheets(Ziel).Cells(D, 6).Value
zahlein = Worksheets(Ziel).Cells(D, 7).Value
Cells(D, 2).HorizontalAlignment = xlCenter 'Zentriert die 500xxx Nummer
Cells(D, 3).HorizontalAlignment = xlCenter 'Zentriert die Shipment
Cells(D, 4).Style = "Currency" 'Formatiert die Zahl wie gewünscht
If datum <= Date And zahlein = "" And fallig <> "" Then
Q = Q + Worksheets(Ziel).Cells(D, 4).Value
Cells(D, 6).Interior.Color = RGB(226, 166, 200) 'farbe in RGB format suchen und anpassen bei bedarf
Cells(D, 6).Font.Bold = True 'macht im falle dass die Zahlung fällig ist die schrift das datums fett
If fallig <> "" Then
Worksheets(Ziel).Cells(D, 9).Value = Date - datum
Cells(D, 9).Font.Bold = True 'macht im falle dass die Zahlung fällig ist die schrift die anzahl der tage seitdem es überfällig ist fett
Worksheets(Ziel).Cells(D, 10).Value = "Tagen"
Cells(D, 10).Font.Bold = True 'macht im falle dass die Zahlung fällig ist die schrift des wortes "Tagen" fett
End If
ElseIf Worksheets(Ziel).Cells(D, 4).Value <> "" And zahlein = "" Then
P = Worksheets(Ziel).Cells(D, 4).Value + P
End If
Next D
P = P + Q
Worksheets(Ziel).Cells(3, 12).Value = Q
Worksheets(Ziel).Cells(4, 12).Value = P
Worksheets(Ziel).Cells(3, 11).Value = "Summe offene und fällige Beträge" 'einfach nur eine zellenbeschriftung
Worksheets(Ziel).Cells(4, 11).Value = "Summe offene Beträge" 'einfach nur eine zellenbeschriftung
Worksheets(Ziel).Cells(3, 12).Style = "Currency" 'formatiert die Zahl entsprechend nach currency um
Worksheets(Ziel).Cells(4, 12).Style = "Currency" 'formatiert die Zahl entsprechend nach currency um
Range(Cells(3, 11), Cells(4, 12)).Borders.LineStyle = xlcontinous 'alle zellen im angabe bereich werden mit durchgehenden trennlinien versehen
Range(Cells(3, 11), Cells(4, 12)).Borders.Weight = xlThin 'alle zellen im angabe bereich werden mit dünnen trennlinien versehen
Range(Cells(3, 11), Cells(4, 12)).BorderAround Weight:=xlThick 'alle 4 Zellen werden mit einem dicken rahmen versehen
Range(Cells(3, 11), Cells(4, 12)).Interior.Color = RGB(226, 166, 200) 'der betroffene bereich wird entsprechend farblich eingefärbt
Range(Cells(3, 11), Cells(4, 12)).Font.Bold = True 'der betroffene Bereich wird auf "fett" formatiert
End Sub
|