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