Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

suche über mehrere Tabellenblätter

suche über mehrere Tabellenblätter
Stefan
Hallo zusammen,
ich weiß hier nicht mehr weiter. Ich will eine Tabelle mit mehreren Blättern auswerten. Die Blätter sind alle gleich aufgebaut. In den Spalten AF und AG stehen die Suchkriterien und in Spalte D steht der zugehörige Name. Nun soll die Auswertung folgendermassen ablaufen: Es soll jedes Arbeitsblatt separat durchsucht werden nach dem Suchkriterium "gering". wenn also in den Spalten AF:AG jeweils "gering" steht, soll der Name aus Spalte D in ein neuangelegtes Tabellenblatt eingetragen werden. Jeder weitere gefundene Name soll dann in die nächste Zelle dahinter eingetragen werden. Als Überschrift über diese Namenszeile wäre dann der jeweilige Arbeitsblattname zu schreiben.
Das Ergebnis wäre also ein neues Tabellenblatt mit den verschiedenen Auswertungen über alle Tabellen blätter ungefähr in so einer Form:
---------------
NameBlatt1
gering - gering - Name1 - Name2 - Name3 - Name4...
NameBlatt2
gering - gering - Name1 - Name2 - Name3 - Name4...
NameBlatt3
gering - gering - Name1 - Name2 - Name3 - Name4...
---------------
Hat irgendjemand eine Idee, wie man soetwas am Besten umsetzt?
Vielen Dank schon mal im voraus für Eure Mühen
Gruß
Stefan

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: suche über mehrere Tabellenblätter
10.03.2011 20:07:39
Josef

Hallo Stefan,
teste mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub sucheAlleTabellen()
  Dim objSh As Worksheet, objNew As Worksheet
  Dim rng As Range, lngNext As Long, lngCol As Long
  Dim strSearch As String, strFirst As String
  
  On Error GoTo ErrExit
  GMS
  
  strSearch = "gering"
  
  lngNext = 1
  
  Set objNew = ThisWorkbook.Worksheets.Add(before:=ThisWorkbook.Sheets(1))
  objNew.Name = "Suche " & Format(Now, "ddMMyy hhmmss")
  
  For Each objSh In ThisWorkbook.Worksheets
    If Not objSh Is objNew Then
      lngCol = 2
      objNew.Cells(lngNext, 1) = objSh.Name
      objNew.Cells(lngNext + 1, 1) = strSearch & " - " & strSearch
      Set rng = objSh.Range("AF:AF").Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole, _
        MatchCase:=False, SearchFormat:=False)
      
      If Not rng Is Nothing Then
        strFirst = rng.Address
        Do
          If rng.Offset(0, 1) = strSearch Then
            objNew.Cells(lngNext + 1, lngCol) = objSh.Cells(rng.Row, 4).Value
            lngCol = lngCol + 1
          End If
          Set rng = objSh.Range("AF:AF").FindNext(rng)
        Loop While Not rng Is Nothing And strFirst <> rng.Address
      End If
      lngNext = lngNext + 3
    End If
  Next
  
  objNew.Columns.AutoFit
  
  ErrExit:
  GMS True
  Set rng = Nothing
  Set objSh = Nothing
  Set objNew = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
    
  End With
  
End Sub


Gruß Sepp

Anzeige
AW: suche über mehrere Tabellenblätter
10.03.2011 20:51:17
Stefan
Hallo Sepp,
vielen Dank. Du bist der Größte!!!!!!!!! Funktioniert super!!
Schönen Gruß
Stefan

377 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige