auch dir herzlichen Dank für deine Rückmeldung. Ist schon interessant, wie viele Rückmeldungen aman bekommt und jeder hat noch einen weiteren Tipp, wie mal die Vorlage verbessern kann. Herzlichen Dank.
Ich habe gerade mal geschaut, deine Änderung herunter zu laden. Bekomme hier aber "about:blank" angezeigt.....ich werde hier auf eine leere Seite verwiesen.
ich konnte die Datei ganz normal runterladen. Diese lässt sich auch ganz normal öffnen und funktioniert. Es kann schon mal passieren das beim Hochladen was schiefläuft. Aber in diesem Fall ist alles ok.
vielen Dank für deine Anregungen. Werde mir das am Wochenende mal zu Gemüte führen.
Zitat:Die farbliche Kennzeichnung würde ich mit bedingter Formatierung erschlagen.
was die bedingten Formatierungen betrifft, davon hatte ich Abstand genommen, da die ja in gewisser Weise auch zu den volatilen Funktionen gehören. Das Kalendarium ist in diesem Fall aber eher als statisch anzusehen. Auch bei den Feiertagen wird es nicht so oft zu Änderungen kommen, das es einen Benefit bringt.
Viele Grüße Klaus-Dieter Der Erfolg hat viele Väter, der Misserfolg ist ein Waisenkind Richard Cobden
anbei ein Vorschlag, wie das Ganze auch bei größeren Datenmengen in der Timline flott läuft. Ich bin etwas anders vorgegangen. Das Blockweise Schreiben erfolgt nach Kunden. Dies ermöglicht auch die Farbe im Block mit zu übergeben. Die einzige Bremse ist nur noch .CountIf
Ins Modul des Tabellenblattes "Übersicht":
Code:
Option Explicit Private Const Startzeile As Long = 3
Private Sub Worksheet_Activate() Dim i&, j&, arrKD(), arrHotel(), tmp(), datSart As Variant, datEnde As Variant, iZeile&, varHund$, varKatze$, arrH(), arrK() With Tabelle2.ListObjects(1).DataBodyRange arrKD = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 2, 3, 9)) For i = 1 To UBound(arrKD) arrKD(i, 4) = .Cells(i, 9).Interior.Color Next i End With With Tabelle1.ListObjects(1).DataBodyRange arrHotel = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 3, 4, 5, 11, 13, 14, 15)) End With Rows("4:" & Tabelle4.Range("A4").End(xlDown).Row).Delete Cells(2, 2) = "Anzahl" Cells(3, 2) = "Anzahl" Cells(2, 3) = "Hunde" Cells(3, 3) = "Katzen" With Tabelle1.ListObjects(1).DataBodyRange tmp = Application.Index(.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 4, 5)) End With Cells(Startzeile + 1, 1).Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp For i = 1 To UBound(arrKD) For j = 1 To UBound(arrHotel) If arrKD(i, 1) = arrHotel(j, 2) Then datSart = Application.Match(CLng(CDate(arrHotel(j, 7))), Rows(1), 0) datEnde = Application.Match(CLng(CDate(arrHotel(j, 8))), Rows(1), 0) If arrHotel(j, 6) = "Hund" Then If Len(varHund) < 220 Then varHund = varHund & Replace(Cells(j + Startzeile, datSart).Address, "$", "") & ":" & Replace(Cells(j + Startzeile, datEnde).Address, "$", "") & "," Else Range(Left(varHund, Len(varHund) - 1)) = "H" Range(Left(varHund, Len(varHund) - 1)).HorizontalAlignment = xlCenter Range(Left(varHund, Len(varHund) - 1)).Interior.Color = arrKD(i, 4) varHund = "" End If ElseIf arrHotel(j, 6) = "Katze" Then If Len(varKatze) < 220 Then varKatze = varKatze & Replace(Cells(j + Startzeile, datSart).Address, "$", "") & ":" & Replace(Cells(j + Startzeile, datEnde).Address, "$", "") & "," Else Range(Left(varKatze, Len(varKatze) - 1)) = "H" Range(Left(varKatze, Len(varKatze) - 1)).HorizontalAlignment = xlCenter Range(Left(varKatze, Len(varKatze) - 1)).Interior.Color = arrKD(i, 4) varKatze = "" End If End If End If Next j If varHund <> "" Then Range(Left(varHund, Len(varHund) - 1)) = "H" Range(Left(varHund, Len(varHund) - 1)).HorizontalAlignment = xlCenter Range(Left(varHund, Len(varHund) - 1)).Interior.Color = arrKD(i, 4) varHund = "" ElseIf varKatze <> "" Then Range(Left(varKatze, Len(varKatze) - 1)) = "K" Range(Left(varKatze, Len(varKatze) - 1)).HorizontalAlignment = xlCenter Range(Left(varKatze, Len(varKatze) - 1)).Interior.Color = arrKD(i, 4) varKatze = "" End If Next i ReDim arrH(1 To 1, 1 To Cells(1, Columns.Count).End(xlToLeft).Column - 3) arrK = arrH iZeile = Startzeile + UBound(arrHotel) For i = 4 To Cells(1, Columns.Count).End(xlToLeft).Column arrH(1, i - 3) = Application.WorksheetFunction.CountIf(Range(Cells(4, i), Cells(iZeile, i)), "H") arrK(1, i - 3) = Application.WorksheetFunction.CountIf(Range(Cells(4, i), Cells(iZeile, i)), "K") Next i Cells(2, 4).Resize(1, UBound(arrH, 2)) = arrH Cells(3, 4).Resize(1, UBound(arrK, 2)) = arrK End Sub
Das ist der zügigste Lösungsansatz, die mir eingefallen ist.
was die Geschichte VBA anbetrifft, da bin ich völlig raus, da ich ja.....wie eingangs schon mal da und da erwähnt habe.....völliger Anfänger bin. Aber auch hier wieder erst einmal herzlichen Dank, dass ihr euch hier soviel Mühe gibt. Ich hatte letztens mal noch mein kleines Problem mit dem Rechnungsprogramm angesprochen. Und ich hatte hier auch mal angeführt, dass ich im Netz etwas gefunden habe. Ich stelle die Datei hier noch einmal hinein und frage ganz lieb, ob man dieses Rechnungsprogramm vielleiht mit in unsere Datei mit einbinden kann.
Mal eine Bemerkung zu deinem Vorhaben. Da du die Hundebetreuung und Rechnungserstellung ja auf 2 PCs Bedienen willst, ist dir wohl klar, dass du dir dazu eine Serverumgebung aufbauen musst, da die Daten nur auf einem von beiden PCs gemeinsam nutzbaren Laufwerk liegen dürfen.
Da dürfte es wohl durchaus relativ unkomplizierte Lösungen geben, muss aber beachtet werden.
Folgende(r) 1 Nutzer sagt Danke an ws-53 für diesen Beitrag:1 Nutzer sagt Danke an ws-53 für diesen Beitrag 28 • Christo
04.11.2024, 12:01 (Dieser Beitrag wurde zuletzt bearbeitet: 04.11.2024, 12:02 von Egon12.)
Hallo Claudia,
was Rechnungen in Excel schreiben betrifft kann man dir nur raten deinem Steuerberater zu konsultieren, ob dein Finanzamt dies zulässt und wenn ja unter welchen Bedingungen. Vorher macht es wenig Sinn sich im Zusammenhang mit Excel damit auseinanderzusetzen.
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
