In Tabellen suchen und Resultat kopieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: In Tabellen suchen und Resultat kopieren
von: Lucien
Geschrieben am: 09.10.2003 10:41:00

Guten Morgen

Ich habe folgendes Problem:
Ein Makro wäre sehr gut.
Ich habe 30 bzw. 31 Tabellenblätter in einer Mappe.
Hier trägt nun die Sekretärin ein ob das Personal anwesend ist oder nicht.
z.B. Tabelle 1 heisst "01.01.2003" und in jeder Tabelle stehen die 20 Mitarbeiter d.h. alle Tabellen sind gleich nur der Namen des Blattes wechselt.
Die Sekretärin trägt nun ein Mitarbeiter Charlie "Nein".

Ich möchte nun nicht jedesmal die 30 b.z.w.31 Tablellenblätter durchsuchen müssen um zu sehen wer anwesend war oder nicht.
Ich Möchte nun dass Excel wenn in der Reihe "D" ( es ist immer "D") eines Tabellenblattes "nein" steht mir die ganze Reihe wo das Nein steht -z.B. Reihe 3 so dass ich den Namen und das "nein" - untereinander in ein neues Tabellenblatt kopieren z.B. "Nichtanwesend".??
Ich hoff das war nicht zu langweilig

Gruss lucien und danke im voraus

Bild


Betrifft: AW: In Tabellen suchen und Resultat kopieren
von: Willie
Geschrieben am: 09.10.2003 11:23:26

Hallo Lucien für in deine Tabelle ein weiteres Tabellenblatt ein und benenne es um
nach "Übersicht"
dann das Makro laufen lassen und es werden alle Datensätze mit nein übertragen!
Gruß
Willie
Falls es probleme gibt ... einfach nochmal melden!

Public

Sub suchen()
ThisWorkbook.Activate
    Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Integer
    Dim index As Integer, Feld() As String, Tabelle() As Integer, Zeile_Spalte() As String
    Dim Suche As Variant
    i = 3
    Suchbegriff = "nein" 'InputBox("Suchbegriff eingeben", "Eingabe")
    If Suchbegriff <> "" Then
        For index = 1 To Worksheets.Count
            With Sheets(index).Cells
                Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlPart)
                If Not Zelle Is Nothing Then
                    Adresse = Zelle.Address
                    Do
                        zaehler = zaehler + 1
                        ReDim Preserve Feld(1 To zaehler)
                        ReDim Preserve Tabelle(1 To zaehler)
                        ReDim Preserve Zeile_Spalte(1 To zaehler)
                        Feld(zaehler) = Sheets(index).Name & " Spalte " & Zelle.Column & " Zeile " & Zelle.Row
                        Tabelle(zaehler) = index
                        Zeile_Spalte(zaehler) = Zelle.Address
                        Set Zelle = .FindNext(Zelle)
                    Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
                End If
            End With
        Next
        If zaehler > 0 Then
            If MsgBox(Suchbegriff & " wurde " & CStr(zaehler) & " mal gefunden." & vbNewLine & "Fundstellen übertragen?", 68, "Information") = 7 Then Exit Sub
            Do
                For index = 1 To zaehler
                
                    Sheets(Tabelle(index)).Select
                    Range(Zeile_Spalte(index)).Select
                    ActiveWindow.ScrollColumn = Selection.Column
                    ActiveWindow.ScrollRow = Selection.Row
                    Suche = ActiveWindow.ScrollRow
                    If Suche > 2 Then
            
                Range("A" & Suche & ":CM" & Suche).Select
                Selection.Copy
                Blattname = ActiveSheet.Name
                
               Sheets("Übersicht").Activate
                
                Cells(i, 1).Select
                i = i + 1
                ActiveSheet.Paste
                Else
                  GoTo weiter
                  End If
weiter:
                    If zaehler = 1 Then Exit Sub
                    If index < zaehler Then
                        'If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Weitere anzeigen?", 68, "Information") = 7 Then Exit Sub
                    Else
                        If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Nochmal übertragen?", 68, "Information") = 7 Then Exit Do
                    End If
                Next
            Loop
        Else
            MsgBox Suchbegriff & " wurde nicht gefunden", 64, "Information"
        End If
    End If
    ThisWorkbook.Activate
    
End Sub



Bild


Betrifft: AW: In Tabellen suchen und Resultat kopieren
von: LUCIEN
Geschrieben am: 09.10.2003 15:18:48

Hallo
Willie

Ich werde das wenn ich auf der Arbeit bin gleich umsetzen.
Bei einel Problem werde ich mich wieder merlden
Danke für deine arbeit

Gruss Lucien


 Bild

Beiträge aus den Excel-Beispielen zum Thema " In Tabellen suchen und Resultat kopieren"