|
Hi,
ich habe jetzt folgendes Makro geschrieben, was durchaus seine function erfüllt. jedoch würde ich gerne jede Quelle lieber über ein sub bearbeiten. komischerweise become ich das partout nicht hin. hat hier jemand einen tipp?
<<
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 'Zaehler
Dim Quelle1, Quelle2, Quelle3, Quelle4, Quelle5, Quelle6, Quelle7, Quelle8, Quelle9 As String 'Konstante fuer Worksheet 1
Dim Ziel, fallig, zahlein As String 'Konstante fuer Ziel Worksheet
Dim currentDate, datum As Date
'==========================================
'Definition der Sheets welche durchforstet werden
Quelle1 = "A1"
Quelle2 = "A2"
Quelle3 = "A3"
Quelle4 = "A4"
Quelle5 = "A5"
Quelle6 = "A6"
Quelle7 = ""
Quelle8 = ""
Quelle9 = ""
Ziel = "Forderungsübersicht"
'=========================================
'
Rows("2:801").delete
'Variable für Zeile "Z"; Beschriftung startet in Zeile 3
Z = 2
'===========================================================================================Quelle1
For A = 1 To 150
C = Worksheets(Quelle1).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle1).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle1).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle1).Cells(A, 16).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle1).Cells(A, 8).Value
ElseIf Worksheets(Quelle1).Cells(A, 16).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle1).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle1).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle1).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle1).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle1).Cells(A, 16).Value
Z = Z + 1
End If
Next A
'===========================================================================================Quelle2
For A = 1 To 150
C = Worksheets(Quelle2).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle2).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle2).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle2).Cells(A, 17).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle2).Cells(A, 8).Value
ElseIf Worksheets(Quelle2).Cells(A, 17).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle2).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle2).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle2).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle2).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle2).Cells(A, 17).Value
Z = Z + 1
End If
Next A
'==============================================================================================Quelle3
For A = 1 To 150
C = Worksheets(Quelle3).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle3).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle3).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle3).Cells(A, 17).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle3).Cells(A, 8).Value
ElseIf Worksheets(Quelle3).Cells(A, 17).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle3).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle3).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle3).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle3).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle3).Cells(A, 17).Value
Z = Z + 1
End If
Next A
'===========================================================================================Quelle4
For A = 1 To 150
C = Worksheets(Quelle4).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle4).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle4).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle4).Cells(A, 17).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle4).Cells(A, 8).Value
ElseIf Worksheets(Quelle4).Cells(A, 17).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle4).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle4).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle4).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle4).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle4).Cells(A, 17).Value
Z = Z + 1
End If
Next A
'===========================================================================================Quelle5
For A = 1 To 150
C = Worksheets(Quelle5).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle5).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle5).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle5).Cells(A, 17).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle5).Cells(A, 8).Value
ElseIf Worksheets(Quelle5).Cells(A, 17).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle5).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle5).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle5).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle5).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle5).Cells(A, 17).Value
Z = Z + 1
End If
Next A
'===========================================================================================Quelle6
For A = 1 To 150
C = Worksheets(Quelle6).Cells(A, 13).Value
D = Left(C, 1)
If D = "5" Then
Worksheets(Ziel).Cells(Z, 2).Value = Worksheets(Quelle6).Cells(A, 13).Value 'Rechnungsnummer
Worksheets(Ziel).Cells(Z, 3).Value = Worksheets(Quelle6).Cells(A, 2).Value 'Shipment
If Worksheets(Quelle6).Cells(A, 17).Value = "Delivery Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle6).Cells(A, 8).Value
ElseIf Worksheets(Quelle6).Cells(A, 17).Value = "Final Payment" Then
Worksheets(Ziel).Cells(Z, 4).Value = Worksheets(Quelle6).Cells(A, 6).Value
End If
Worksheets(Ziel).Cells(Z, 5).Value = Worksheets(Quelle6).Cells(A, 4).Value 'Rechnungsdatum
Worksheets(Ziel).Cells(Z, 6).Value = Worksheets(Quelle6).Cells(A, 12).Value 'Fälligkeitsdatum
Worksheets(Ziel).Cells(Z, 7).Value = Worksheets(Quelle6).Cells(A, 11).Value 'Zahlungseingang
Worksheets(Ziel).Cells(Z, 8).Value = Worksheets(Quelle6).Cells(A, 17).Value
Z = Z + 1
End If
Next A
'=======================================================Datum & Betrag Check!
'P werden die Summe von allen offenen Beträgen
'Q wird die Summe von allen offenen und fälligen Beträgen
P = 0
Q = 0
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>>
|