Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
624to628
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Arbeitsmappe durchsuchen & Ergebnise anzeigen
23.06.2005 10:57:01
Rausch
Hallo,
habe da ein grosses Problem und hoffe es kann mir jemand helfen.
Ich habe eine Excel Datei mit 40 Tabellenblätter und möchte einer
Schaltfläche ein Makro zuweisen worauf sich ein Fenster öffnen sollte wo ich
dann einen Begriff hineinschreiben kann und eine Suche über alle 40 Blätter
nach dem Begriff gestartet werden sollte. Am Ende der Suche sollte es möglich
sein mir die Anzahl der gefundenen Begriffe zu zeigen sowie auf einem Extra Tabellenblatt, was ich vorher anlege, alle Tabellenblattnamen wo der Begriff vorkommt, aufzulisten.
Beispiel:
1. Tabellenblatt heisst Hugo
2. Tabellenblatt heisst Bernd
3. Tabellenblatt heisst Gabi
4. Tabellenblatt heisst Silvio
Eine Tabelle hat den Namen "Suchergebnisse"
usw.
In diesen Blättern sind Daten wie z.B. Städtenamen eingetragen, wie etwa Bern
Nun möchte ich das ich auf meine Schaltfläche klicke worauf sich ein Fenster öffnet und mir sagt: "Geben Sie den gewünschten Suchbegriff ein"
Dort gebe ich dann z.B. "Bern" ein
Anmerkung: Aus Bern kommen Gabi und Hugo
Es sollte dann die Suche gestartet werden und danach als Ergenis "2 Treffer" herauskommen aber auch in meinem Tabellenblatt "Suchergebnisse" sollte dies nun ersichtlich sein.
Dort müsste dann eine Auflistung der Tabellenblattnamen mit den gefundenen Begriffen stehen, also so wie hier im Beispiel müsste dann als Ergenis folgendes dastehen:
Gabi
Hugo
Habe bereits alles mit der eingebauten Suchfunktion von Excel probiert, komme aber nicht mehr weiter und bitte darum Euch um Hilfe mir ein mögliches Makro zu erstellen. Ich Danke allen die mir eine Antwort schreiben und verbleibe mit freundlichen Grüssen
Kurt

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsmappe durchsuchen & Ergebnise anzeigen
23.06.2005 11:22:48
GraFri
Hallo
Vielleicht hilft dir folgender Code weiter.


      
Option Base 1
Option Compare Text
Sub Suchen_und_anzeigen()
Dim Meldung         As Byte, Pos        As Byte
Dim Schleife        As Byte, y          As Byte
Dim Begriff, Suchen()                   As Variant
Dim Bereich                             As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$
'Bereich festlegen
Set Bereich = Application.InputBox _
("Bitte den zu durchsuchenden Bereich eingeben " & vbCrLf & _
 "(z.B.:  A1:A200),oder markieren Sie den Such-" & vbCrLf & _
  "bereich im Tabellenblatt.", "Bereich festlegen", "A1:A200", Type:=8)
' Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Wert eingeben. Sollen 2 Werte" & vbCrLf & _
 "gleichzeitig gesucht werden, dann mit Zeichen  +  " & vbCrLf & _
 "voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
 "ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Begriff = "" Then Exit Sub
Pos = InStr(Begriff, "+")
If Pos Then
    
ReDim Suchen(2)
    Suchen(1) = Left(Begriff, Pos - 1)
    Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
    Schleife = 2
Else
    
ReDim Suchen(1)
    Suchen(1) = Begriff
    Schleife = 1
End If
Application.ScreenUpdating = 
False
' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
' des Bereiches beginnt.
With Worksheets(1).Range(Bereich.Address)
    xZelle = .Columns(.Columns.Count).Column
    yZelle = .Rows(.Rows.Count).Row
End With
' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
For n = 1 To Sheets.Count
With Sheets(n).Range(Bereich.Address)
    
Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)
    
If Not c Is Nothing Then
        ErsteAdresse = c.Address
        
Do
            
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
            xTabelle(x) = Sheets(n).Name
            Adresse(x) = c.Address(RowAbsolute:=
False, ColumnAbsolute:=False)
            
Set c = .FindNext(c)
            x = x + 1
        
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
    
End If
End With
Next n
Next y
Application.ScreenUpdating = 
True
' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
' gefunden wurde dann ist x = 1
Select Case x
Case 1
    Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
    
Exit Sub
Case Else
    Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
'Tabelle einfügen
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
    .Name = "Suchergebnis"
    .[A1] = "Tabelle"
    .[B1] = "Zelle"
    
For n = 1 To x - 1
        .Cells(n + 1, 1) = xTabelle(n)
        .Cells(n + 1, 2) = Adresse(n)
    
Next n
End With
End Select
End Sub
Bei weiteren Fragen einfach melden.
mfg, GraFri
Anzeige
AW: Arbeitsmappe durchsuchen & Ergebnise anzeigen
23.06.2005 11:56:59
Rausch
Hallo,
danke für die Antwort. Ja es sit so wie ich es mir vorstelle, nur beim klick
auf meine Schaltfläche fragt er jetzt nach Bereich festlegen. Es wäre toll wenn dies nicht da wäre, sondern einfach eine Zeile wo ich meinen Begriff eingeben kann da der Bereich ja alle Tabellenblätter sind.
mfg Kurt
AW: Arbeitsmappe durchsuchen & Ergebnise anzeigen
23.06.2005 12:20:38
GraFri
Hallo
Geänderter Code. Sollte so funktionieren.


      
Option Base 1
Option Compare Text
Sub Suchen_und_anzeigen()
Dim Meldung         As Byte, Pos        As Byte
Dim Schleife        As Byte, y          As Byte
Dim Begriff, Suchen()                   As Variant
Dim Bereich                             As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$
' Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Wert eingeben. Sollen 2 Werte" & vbCrLf & _
 "gleichzeitig gesucht werden, dann mit Zeichen  +  " & vbCrLf & _
 "voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
 "ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Begriff = "" Then Exit Sub
Pos = InStr(Begriff, "+")
If Pos Then
    
ReDim Suchen(2)
    Suchen(1) = Left(Begriff, Pos - 1)
    Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
    Schleife = 2
Else
    
ReDim Suchen(1)
    Suchen(1) = Begriff
    Schleife = 1
End If
Application.ScreenUpdating = 
False
' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
  
For n = 1 To Sheets.Count
  
  
' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
  ' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
  ' des Bereiches beginnt.
  'Bereich festlegen
  Set Bereich = Worksheets(n).UsedRange
  
  
  
With Worksheets(n).Range(Bereich.Address)
      xZelle = .Columns(.Columns.Count).Column
      yZelle = .Rows(.Rows.Count).Row
  
End With
  
With Sheets(n).Range(Bereich.Address)
      
Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)
      
If Not c Is Nothing Then
          ErsteAdresse = c.Address
          
Do
              
ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
              xTabelle(x) = Sheets(n).Name
              Adresse(x) = c.Address(RowAbsolute:=
False, ColumnAbsolute:=False)
              
Set c = .FindNext(c)
              x = x + 1
          
Loop While Not c Is Nothing And c.Address <> ErsteAdresse
      
End If
  
End With
  
Next n
Next y
Application.ScreenUpdating = 
True
' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
' gefunden wurde dann ist x = 1
Select Case x
Case 1
    Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
    
Exit Sub
Case Else
    Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
'Tabelle einfügen
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
    .Name = "Suchergebnis"
    .[A1] = "Tabelle"
    .[B1] = "Zelle"
    
For n = 1 To x - 1
        .Cells(n + 1, 1) = xTabelle(n)
        .Cells(n + 1, 2) = Adresse(n)
    
Next n
End With
End Select
End Sub
Bei weiteren Fragen einfach melden.
mfg, GraFri
Anzeige
AW: Arbeitsmappe durchsuchen & Ergebnise anzeigen
23.06.2005 12:39:23
Rausch
Hallo,
ich Danke Dir recht Herzlich. Es sit genau so wie ich es mir Vorgestellt habe.
Wünsche noch eine schöne und erfolgreiche Woche.
mfg Kurt

123 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige