Thema Datum  Von Nutzer Rating
Antwort
24.03.2016 13:31:49 Marco
NotSolved
Blau Durchsuchen von Tabellen und Ausgabe
26.03.2016 16:46:28 trinchen
NotSolved
26.03.2016 18:27:47 Gast14721
NotSolved
29.03.2016 07:12:47 Gast29580
NotSolved
30.03.2016 16:17:07 Gast70117
NotSolved

Ansicht des Beitrags:
Von:
trinchen
Datum:
26.03.2016 16:46:28
Views:
893
Rating: Antwort:
  Ja
Thema:
Durchsuchen von Tabellen und Ausgabe

Hallo

Anbei erst mal der Code, damit die Kopie deiner Zeilen ausgegeben wird. Ich hoffe das ich es richtig verstanden habe.

Meld Dich halt zurück.

 

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Private Sub CommandButton1_Click()
  
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 Begriff 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 = "Startseite"
    .[I5] = "Suchergebnis"
      
  
    For n = 1 To x - 1
        .Cells(n + 7, 9) = xTabelle(n)
        .Cells(n + 7, 10) = Begriff
    Next n
End With
End Select
  
  
End Sub

Gruß & Frohe Ostern

Den Rest versuche ich noch zu klären

 


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:



  • 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
24.03.2016 13:31:49 Marco
NotSolved
Blau Durchsuchen von Tabellen und Ausgabe
26.03.2016 16:46:28 trinchen
NotSolved
26.03.2016 18:27:47 Gast14721
NotSolved
29.03.2016 07:12:47 Gast29580
NotSolved
30.03.2016 16:17:07 Gast70117
NotSolved