Office: (Office 365) VBA: Wenn Bedingung erfüllt, dann Kopiere Wert..

Hallo zusammen,

ich bin absoluter Anfänger im Bereich VBA und bräuchte Eure Hilfe!
Ich habe in einem Tabellenblatt eine Liste mit Namen und Daten.
Rechts neben der Liste soll nun für jede Zelle abgefragt werden, ob die Bedingungen die sich aus der Tabelle ergeben für diese Zelle gelten. Falls das der Fall ist, soll der Name aus der Tabelle in die aktive Zelle kopiert werden.
Das Tool soll durchgehend laufen und in einem festgelegten Bereich des Tabellenblatts nach erfüllten Bedingungen suchen.

Hintergrund:
Ich möchte aus einer Liste automatisch einen Gantt Chart erstellen. Ich habe soweit alles fertig. Aus einer Tabelle werden Anfangsdatum und Enddatum ausgelesen und durch bedingte Formatierung als Balken visualisiert. Nun möchte ich, dass der Titel des Projekts auf den Balken geschrieben wird.

Das funktioniert auch, wenn ich in jedes Feld (in diesem Fall Aktive Zelle = H14) folgende Abfrage einstelle:

=WENN(UND($F14<=H$13;EDATUM($F14;$G$12)>H$13);$C14&" ("&D14&")";"")

H14 = Aktive Zelle
F14 = Startdatum
H13 = Datum im Gantt Chart
G12 ist ein Skalierungsfaktor des Gantt Charts
C14 ist der Name des Projekts
D14 ist ein Zusatz zum Namen

Wenn ich jetzt allerdings diese Formel für alle Zellen im Gantt-Chart einsetze, dann wird der Text in der aktiven Zelle durch die nächste Zelle abgeschnitten, weil die Zelle eben nicht mehr leer ist, sondern eine Formel enthält (auch wenn der Output der Formel "" ist)... Und leider kann man Excel nicht beibringen, das zu ignorieren. Workarounds habe ich auch schon vergeblich probiert.

Ich brauche also ein Makro, welches die Bedingung in der obigen Formel für einen ganzen Tabelenbereich überprüft und falls die Bedingung wahr ist, in die aktive Zelle die entsprechende Dann-Bedingung aus der Formel einsetzt. Ansonsten sollen die Zellen leer bleiben (also auch keine Formel enthalten).

Ufff.... ich hoffe, Ihr habt mich verstanden...

Danke schon mal für Eure Zeit und Hilfe!

 

Hier noch eine leicht zensierte Version, wie die Liste und der Gantt Chart aussehen. Rechts sieht man auch das Problem, der Titel wird aus der Tabelle links kopiert, allerdings abgeschnitten dargestellt. Das liegt daran, dass die Zellen rechts neben z.B. H14 nicht leer sind sondern eine Formel beinhalten, die "" ausgibt.

 

Habs selbst rausgefunden...

 

Danke das Du uns Deine Lösung nicht zeigst,

 

@Hajo_Zi Danke für diesen freundlichen Seitenhieb. Ich hatte durchaus vor, die Lösung zu zeigen, allerdings nicht mehr Freitag um 16:45 Uhr mit ausformulierten Erklärungen - auch ich habe irgendwann Feierabend. Diese sehr kurze Info war einfach dazu gedacht, dass nicht doch jemand sich an die Fragestellung macht, obwohl ich die Lösung schon selbst gefunden hatte.

Ich finde es bezeichnend, dass sich über 5 Stunden lang niemand meldet (kein Vorwurf, war ja Arbeitstag), es dann aber keine 2 Stunden dauert, bis jemand meckert. Da ich ohne VBA Kenntnisse die Lösung in recht kurzer Zeit zusammengebaut habe, gehe ich davon aus, dass ein VBA versierter User eine Lösung in <5 Minuten hingepinselt hätte.

Seis drum... hier mein Ansatz:

Sub AkronymEinfuegen()

Dim Zeile As Integer
Dim Spalte As Integer
Dim n As Integer
Dim i As Integer
'n und i sind Spalten- bzw. Zeilenzähler

Dim nE As Integer
Dim iE As Integer
'Manuelle Eingabe, bis zu welcher Spalte-/Zeile gezählt werden soll
'Grund für das Limitieren der abzusuchenden Matrix ist Laufzeit des Makros

nE = Cells(12, 4) - 1
iE = Cells(12, 3) - 1
'In diesen Zellen werden die höchste Spalten-/Zeilennummer eingegeben, -1 wegen Zählung ab 0.

Range("H14:JW321").ClearContents
'Löscht im relevanten Bereich alle Werte aus den Zellen, Formatierungen sollen beibehalten werden.

Zeile = 14
Spalte = 8
'Hier wird die kleinste Zeile/Spalte festgelegt ab denen gezählt wird

i = 0
n = 0
'Gezählt wird ab 0.

For i = 0 To iE 'Diese Schleife durchläuft alle Zeilen
For n = 0 To nE 'Diese Schleife durchläuft alle Spalten
If Cells(Zeile + i, 6) <= Cells(13, Spalte + n) And (Cells(Zeile + i, 6) + Cells(12, 7) * 30) > Cells(13, Spalte + n) Then

'zu erfüllende Bedingung, siehe WENN-Abfrage oben, Der Faktor 30 ist ein Notbehelf, Cells(12, 7) gibt eine Verschiebung in Monaten an. Diese muss ich zu dem Datum in Cells(Zeile + 1, 6) addieren. In Excel geht das recht einfach mit EDATUM, in VBA scheint das komplizierter... Mit dieser Notlösung sollte das Makro in 99,9% aller Fälle richtig liegen und für den Rest würde ich eine manuelle Korrektur in Betracht ziehen.​

Cells(Zeile + i, 3).Copy
Cells(Zeile + i, Spalte + n).PasteSpecial Paste:=xlValues

'Kopiert entsprechendes Akronym und fügt es in die gewünschte Zelle ein, i und n zählen entsprechend weiter​

End If
Next n
Next i

End Sub