suche name, kopiere bestimmte zelle

[Exceljunge]

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

[Kuwer]

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

[Exceljunge]

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

[Kuwer]

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

[Rabe]

Hi Flo,

             
 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.

[Exceljunge]

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