Bereich finden - darin suchen - ausgeben
Malte
Hallo,
ich habe ein Problem. Ich dachte ich kann es lösen. Meine Lösungsidee hat sich für mich logisch aneghört, jedoch in der Praxis bin ich auf viele Probleme gestoßen und bin nun an meiner Kentniss-Grenze angelangt, nachdem ich die ganze Zeit herumprobiert habe.
Ich habe hier heute Morgen schon im dem Forum um Hilfe gefragt und Rudi Maintaire hat mir wirklich gute Ideen gegeben, doch damit komme ich ebenfalls nicht weiter. Vermutlich auch aufgrund meiner bescheidenen VBA Kentnisse.
Zu dem Problem: (Beispiel s.u.)
In der Tabelle gibt es verschiedene Personen (Frank, Peter und Karin) diese müssen bei den einzelnen Personen (z.B. Max Mustermann oder Inge Test) bestimmte Dinge erledigen (Einkaufen, Aufräumen etc.).
Das Problem ist nun, jeder dieser Tätigkeiten ist eine andere Nummer zugewiesen (Einkaufen bei Max Mustermann die 644, Abholen bei Fritz Meier die 111 wobei bei Frau Musterfrau das Abholen und der Nummer 90 läuft).
Sinn der VBA Anwendung soll es nun sein, ein extra Arbeitsblatt zuerstellen, z.B. 72h / 1M / 6M wo die einzelnen Arbeiten aufgelistet werden. Sprich was ist nach 72h zu tun, was nach einem Monat, was nach 3 Monaten (wobei dies ja 1M mit einbegreift)? (Abholen bei Fritz meiner, Einkaufen bei Maxmustermann). Wichtig ist dabei aber, dass dennoch alle Nummer mit aufgeführt werden für die 1M Tabelle sollte es dann so aussehen.
https://www.herber.de/bbs/user/79239.xlsx
Meine Idee war es, die Zellformatierung ans Anhaltspunkt zu nehmen (xlEdgeBottom Stärke: _ xlMedium). Daraus wollte ich den Bereich abgreifen, den ich nach den einzelnen Intervallen durchsuchen muss. Da hatte ich schon die ersten Probleme. Rudi Maintaire hat mir folgendes an die Hand gegeben.
Function CheckBereich(rngCheck As Range)
Dim rngC As Range, rngStart As Range
For Each rngC In rngCheck 'alle Zellen im Bereich durchlaufen
If rngC.Borders(xlEdgeBottom).Weight = xlMedium Then
'Zelle hat dicken Rahmen
If rngStart Is Nothing Then 'noch keine Zelle mit Rahmen gefunden dann
Set rngStart = rngC.Offset(1) 'Startzelle setzen
Else
If CheckBereich = "" Then
'Adresse des ersten Bereichs
CheckBereich = Range(rngStart, rngC).Address(0, 0)
Else
'weitere Adressen mit ", " getrennt anhängen
CheckBereich = CheckBereich & ", " _
& Range(rngStart, rngC).Address(0, 0)
End If
Set rngStart = rngC.Offset(1) 'neue Startzelle setzen (1 tiefer)
End If
End If
Next
End Function
Damit konnte man nun alle Bereich festlegen. Als String gespeichert. Also habe ich angefangen die Strings auseinander zupflücken bis zum jeweiligen ",". Dies ist allerdings in Chaos ausgeartet und bewirkt alles, nur nicht das was es soll. Vor allem bei Rund 400 Datensätzen.
Kann mir jemand von Euch einen Rat geben, wie ich hier am besten vorgehen muss, damit ich das mit Struktur und Sinn gelöst bekomme? Mittlerweile tapere ich nur von einer Fehlermeldung in die andere und sehe außer "400" keine erfreudigen Messageboxen.
Ich wäre Euch sehr Dankbar.
MfG
Malte
Anzeige