Liebe Community,
ich habe eine knifflige Aufgabe und komme einfach nicht weiter. Ich würde mich über Hilfe freuen!
Ich habe eine Excel-Arbeitsmappe mit dem Sheet "Zusammenfassung"(Ziel) und "offene Punkte"(Quelle).
Im Sheet "Zusammenfassung" möchte ich ein Makro per Schaltfläche starten, welches im Sheet "offene Punkte" in einer bestimmten Spalte "Bearbeiter" nach einen Namen sucht, danach in Spalte "Lösung" nach "Nicht erledigt" sucht bzw. feststellt und dann weiter geht in die Spalte "Zusammenfassung", den zugehörigen Text kopiert und in sheet "Zusammenfassung" in einen, für jeden Bearbeiter bestimmten Bereich, einfügt.
Problem ist, dass Bearbeiter mehrmalsauftreten können. Ich habe im Sheet "Zusammenfassung" verschiedene Textfelder, wo die Texte eingefügt werden müssen. Die Daten aus Sheet "offene Punkte" ändern sich wöchentlich, Tabellenform (spalten) bleibt allerdings gleich.
Ich habe im Anhang die Datei hochgeladen, würde mich über Inspiration freuen.
Liebe Grüße
Hallo,
hier mal ein Grundgerüst für weitere Verfeinerungen:
Sub default()
Dim rngBereich As Range
Dim rngZelle As Range
Dim strBearbeiter As String
Dim strErgebnis As String
Dim strSuchtext As String
strSuchtext = "Nicht erledigt"
strBearbeiter = "Jaguar"
Set rngBereich = Sheets("offenepunkte").Range("A1").CurrentRegion
For Each rngZelle In rngBereich.Columns(5).Cells
If rngZelle.Value = strBearbeiter And rngZelle.Offset(, 4).Value = strSuchtext Then
strErgebnis = strErgebnis & vbNewLine & rngZelle.Offset(, -2).Value
End If
Next
Sheets("Zusammenfassung").TextBoxes("TextBox 35").Text = strErgebnis
End Sub
Gruß Uwe
So geil, ich freue mich!
Vielen Dank Uwe, damit kann ich sehr sehr gut arbeiten. Ich werde dein Grundgerüst verwenden, bisschen damit rumspielen und falls notwendig, nochmal nachfragen :)
Habe mir mal die Mühe gemacht und kommentiert, habe ich das alles so richtig verstanden?
'Sucht nach PROJEKT
strProjekt = "Projektname1"
Set rngBereich = Sheets("Offene Punkte").Range("A1").CurrentRegion 'Setzt den RangeBereich auf das gesamte Sheet Offene Punkte
For Each rngZelle In rngBereich.Columns(4).Cells 'Sucht im RangeBereich in Spalte 4 für jedes * in Zelle
If rngZelle.Value = strProjekt And rngZelle.Offset(, 5).Value = strSuchtext Then 'Wenn in Zelle der Wert gleich dem strProjekt ist und Wert in Zelle gleiche Zeile +5 Spalten der Wert gleich dem strSuchtext ist dann
strErgebnis1 = strErgebnis1 & vbNewLine & rngZelle.Offset(, -1).Value 'deklariere Ergebnis1 ist gleich Ergebnis1 und neue Zeile und Wert in Zelle minus 1 spalte
End If
Next
Sheets("Zusammenfassung").TextBoxes("TextBox 3").Text = strErgebnis1
Wenn nun jemand eine Text Box löscht und eine neue erstellt, muss ich ja das Makro anpassen. Gibt es eine Möglichkeit, die Textfelder zu schützen ?
Zudem, gibt es eine einfach Methode, den Namen der Text Box rauszufinden? Ich habe das immer über "Makro aufzeichnen" gemacht und mir geschaut, was er sagt, wenn ich die Text Box anwähle :19:
Bei den Diagrammen kann man den Namen ja einfach auslesen.
LG Flo
Hallo Flo,
Du hast alles soweit richtig interpretiert.
Es gibt die Application.Caller-Eigenschaft, die den Namen des aufrufenden Objektes zurück gibt.
Im Beispiel wurde den ersten beiden TextBoxen das selbe Makro zugewiesen.
Sub AbfrageOffenePunkte()
Dim rngBereich As Range
Dim rngZelle As Range
Dim strBearbeiter As String
Dim strErgebnis As String
Dim strSuchtext As String
Dim strTextBox As String
strSuchtext = "Nicht erledigt"
strTextBox = Application.Caller 'Zuweisung des Namens der aufrufenden TextBox
Select Case strTextBox 'Bearbeiter werden in Abhängigkeit der aufrufenden TextBox zugeordnet
Case "Textfeld 35"
strBearbeiter = "Jaguar"
Case "Textfeld 42"
strBearbeiter = "Tintenfisch"
End Select
If Len(strBearbeiter) Then 'wenn strBearbeiter nicht leer ist
Set rngBereich = Sheets("offenepunkte").Range("A1").CurrentRegion
For Each rngZelle In rngBereich.Columns(5).Cells
If rngZelle.Value = strBearbeiter And rngZelle.Offset(, 4).Value = strSuchtext Then
strErgebnis = strErgebnis & vbNewLine & rngZelle.Offset(, -2).Value
End If
Next
End If
Sheets("Zusammenfassung").TextBoxes(strTextBox).Text = strErgebnis
End Sub
Gruß Uwe
Hi Flo,
(24.08.2016, 09:24)Exceljunge schrieb: [ -> ]
Set rngBereich = Sheets("Offene Punkte").Range("A1").CurrentRegion 'Setzt den RangeBereich auf das gesamte Sheet Offene Punkte
ich dachte, das setzt den RangeBereich auf den (nicht durch Leerzellen unterbrochenen) belegten Bereich, der sich rechts und unterhalb von A1 befindet.
(18.09.2016, 13:31)Rabe schrieb: [ -> ]Hi Flo,
ich dachte, das setzt den RangeBereich auf den (nicht durch Leerzellen unterbrochenen) belegten Bereich, der sich rechts und unterhalb von A1 befindet.
Hallo Ralf,
ach so ist das? Ja hab erst vor einiger Zeit angefangen mich in VBA reinzufuchsen und leider auch nicht täglich Zeit dafür, meine Kenntnisse zu vertiefen.. bemühe mich aber!
Danke für die Info, wusste ich bis dato nicht. Dass der Rangebereich nur auf den belegten Bereich gesetzt wird, der nicht durch Leerzellen unterbrochen ist, ist natürlich sehr interessant zu wissen! :)
@Uwe
Danke für die Info bezüglich "App.Caller" - die werde ich demnächst mal testen! Habe das gesamte Makro fertig geschrieben und läuft perfekt.. :)
LG Flo