Thema Datum  Von Nutzer Rating
Antwort
Rot auf allen Arbeitsblaettern suchen
 07.10.2013 15:02:28 Motti 2009
NotSolved

Ansicht des Beitrags:
Von:
Motti 2009		 Datum:
07.10.2013 15:02:28		 Views:
1379		 Rating:
     
Antwort:
  Ja
Thema:
auf allen Arbeitsblaettern suchen

Hallo Leute,

ich habe folgenden Code, der die untenstehende Aufgabe ausfuehren soll:

Ich habe mehrere Excel-Blaetter mit jeweils einer grossen Tabelle. Nun moechte ich auf einem extra Excel-Blatt drei Kriterien eingeben koennen in drei Zellen (z. B. Hafen1, Hafen2 und Ladung) und dann auf einen Button druecken und es wird dann in den anderen Excel-Blaettern nach Uebereinstimmungen gesucht und wenn welche gefunden werden, werden diese auf dem Excel-Blatt mit den drei Kriterien weiter unten dargestellt (allerdings nicht nur eine Zelle, sondern gleich die ganze Zeile von den jeweiligen anderen Excel-Blaettern).
 

Und das ist der Code:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub CommandButton1_Click()
 
Dim lngLetzteZeile As Long
Dim lngZeile As Long
Dim rngZelle As Range
Dim wksBlatt As Worksheet
Dim intZaehler As Integer
Dim POL
Dim POD
Dim Commodity
 
POL = Worksheets("Search").Range("B3")
POD = Worksheets("Search").Range("B4")
Commodity = Worksheets("Search").Range("B5")
 
'letzte Zeile in Blatt "Search" feststellen:
lngLetzteZeile = Worksheets("Search").Cells(Rows.Count, 1).End(xlUp).Row + 1
'alte Werte löschen:
Worksheets("Search").Range("A18:AH" & lngLetzteZeile).Clear
'alle Blätter (außer "Search") durchlaufen:
For Each wksBlatt In ThisWorkbook.Worksheets
  If InStr(wksBlatt.Name, "Search") = 0 Then
    'letzte Zeile in Blatt "Search" feststellen:
    lngLetzteZeile = Worksheets("Search").Cells(Rows.Count, 1).End(xlUp).Row + 1
    On Error Resume Next
    'Wenn der Wert von POL in Spalte L gefunden wird:
    If Not IsError(Application.WorksheetFunction.Match(Worksheets("Search").Range("B3"), wksBlatt.Range("L:L"), 0)) Then
      lngZeile = Application.WorksheetFunction.Match(POL, wksBlatt.Range("L:L"), 0)
    'Wenn der Wert von POD in Spalte M der gleichen Zeile gefunden wird:
      If wksBlatt.Cells(lngZeile, 13) = POD Then
        If wksBlatt.Cells(lngZeile, 14) = Commodity Then
          'Den Bereich vom Blatt kopieren und in das Blatt "Search" einfügen:
          wksBlatt.Range("A" & lngZeile & ":AH" & lngZeile).Copy _
          Destination:=Worksheets("Search").Range("A" & lngLetzteZeile & ":AH" & lngLetzteZeile)
        End If
      End If
    End If
  End If
Next wksBlatt
End Sub

Jetzt besteht mein Problem dadrin, dass er nicht alle Blaetter durchsucht, sondern nur die letzten drei und diese auch nicht vollstaendig. Er soll alle Blaetter durchsuchen und auch mehrere Treffer anzeigen (also mehrere Zellen kopieren).

Ist das soweit verstaendlich?

Vielen Danke und liebe Gruesse

Motti

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot auf allen Arbeitsblaettern suchen
 07.10.2013 15:02:28 Motti 2009
NotSolved