Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 16:05:28
PivotChart-Stapeldiagramm erstellen
26.04.2024 15:34:42
Überlagernde Textbox-Ansicht
26.04.2024 15:27:20
Excel öffnet nach Auswahl einer Excel diese leer
26.04.2024 12:46:38
Nutzereingaben Speichern und Laden
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1784to1788
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1784to1788
1784to1788
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Problem mit "Weitersuchen"

Problem mit "Weitersuchen"
28.09.2020 12:36:43
Ahrens
Hallo,
ich bin neu hier und habe nur bedingt Kennznisse von VBA.
Aus diesem Grund hoffe ich bei Euch hilfe zu bekommen.
Ich habe schon aus einem etwas älteren Eintrag bei Euch ein Excel mit einem "fast"
passenden Makro gefunden und konnte es auch ein wenig auf meine Problemstellung anpassen.
Meine Problemstellung ist folgende:
ich habe mehrere XLSX Dateien. Diese Dateien beinhalten Daten von unterschiedlichen Jahrgängen.
Wenn ich jetzt alle diese Dateien in einer Schleife nach einem definierten String durchsuche, läuft meine
Suche auch. Es werden alle Dateien durchsucht und die Daten sauber in einem extra Tabellen Blatt abgelegt.
Leider funktioniert die Suche aber nur begrenzt. Es wird bei der Suche nur der erste erkannte Begriff
als richtiges Ergebniss gefunden und auf der Ergebniss Seite abgelegt.
Die Suche wird nach dem ersten positiven Treffer in der Tabelle beendet und auf den nächsten Tabelle fortgesetzt.
Ich weiss schon, dass hier ein .FindNext die Lösung bringen sollt, nur leider erhalte ich, egal wie und wo ich es einbaue
den Kompilierungsfehler, dass die Methode oder das datenobjekt nicht gefunden wird.
Ich hoffe Ihr könnt mir helfe. Ich stelle Euch die xmlm zur Verfügung.
https://www.herber.de/bbs/user/140487.xlsm
Vielen Dank im Voraus
MfG
Frank

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 12:59:42
Nepumuk
Hallo Frank,
teste mal:
Sub prcAktion(ByVal strDateiName As String)
    Dim rng As Range
    Dim tbl As Worksheet
    Dim wb As Workbook
    Dim strFirsAddress As String
    
    'Datei schreibgeschützt öffnen
    Set wb = Workbooks.Open(Filename:=strDateiName, ReadOnly:=True, UpdateLinks:=0)
    
    Application.StatusBar = "Bearbeite Datei """ & strDateiName & """"
    'Alle Tabellenblätter in Mappe abarbeiten
    For Each tbl In wb.Worksheets
        
        With tbl
            'Suchbegriff suchen
            
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart)
            ', SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=True)
            
            Set rng = .UsedRange.Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart)
            
            If Not rng Is Nothing Then
                
                bolGefunden = True
                strFirsAddress = rng.Address
                
                Do
                    'Nächste frei zeile im Ergebnisblatt
                    lngZeile_E = fncNextFreeRow(wks:=wksErg)
                    If lngZeile_E > 3 Then
                        lngZeile_E = lngZeile_E + 1
                    End If
                    
                    'Daten in Zeile 1 kopieren - Formate und Werte
                    .Range(.Cells(5, 1), .Cells(5, 130)).Copy
                    
                    With wksErg
                        '.Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteFormats
                        .Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteValues
                        .Cells(lngZeile_E, 1).Value = varSuchen
                        .Cells(lngZeile_E, 2).Value = wb.Name
                        .Cells(lngZeile_E + 1, 2).Value = tbl.Name
                    End With
                    
                    'Daten in gefundener Zeile kopieren - Formate und Werte
                    .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 130)).Copy
                    
                    With wksErg.Cells(lngZeile_E + 1, 4)
                        .PasteSpecial Paste:=xlPasteFormats
                        .PasteSpecial Paste:=xlPasteValues
                    End With
                    
                    Set rng = .UsedRange.FindNext(After:=rng)
                    
                Loop Until rng.Address = strFirsAddress
            End If
        End With
        Application.CutCopyMode = False
    Next tbl
    'Datei ohne Speichern schließen
    wb.Close savechanges:=False
    Application.StatusBar = False
End Sub

Gruß
Nepumuk
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 13:49:42
Ahrens
Hallo Nepumuk,
Danke für die schnelle Antwort.
Leider brachte die Änderung nicht den Erfolg.
Wenn ich diese SUB gegen die bestehende austausche werden alle Einrtäge angezeigt, auch denn der SuchString/Teilstring nicht in einem Der Zellen steht. Auch werden Einträge mehrfach angezeigt. Die suche über eine Datei mit 11 Tabellen a 25 Datensätze bring jetzt über 1500 Ergebnisse.
MfG
Frank
AW: Problem mit "Weitersuchen"
28.09.2020 13:57:50
Nepumuk
Hallo Frank,
lade mal eine Testmappe hoch die durchsucht werden soll.
Gruß
Nepumuk
AW: Problem mit "Weitersuchen"
28.09.2020 14:26:50
Ahrens
Hallo Nepumuk,
Hier die Test Mappe.
Als Such-String könnte "AOK" oder "AOK Plus" verwendet werden.
Wenn ich mit meiner "originalen" Suche nach dem String Suche erhalte ich von jeder Tabelle je nur ein Ergebnis (auch wenn mehrere gültige vorhanden sind). Wenn ich das Makro "übernehme" und das SUB austausche, liege ich bei dieser Test-Datei bei 715 Einträge. Wobei auch falsche "Treffer" sind
https://www.herber.de/bbs/user/140492.xlsx
Gruß
Frank
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 14:59:39
Nepumuk
Hallo Frank,
deine Suche nach der nächsten freien Zeile hat die Suche zerschossen. Teste mal damit:
Sub prcAktion(ByVal strDateiName As String)
    Dim rng As Range
    Dim tbl As Worksheet
    Dim wb As Workbook
    Dim strFirsAddress As String
    
    'Datei schreibgeschützt öffnen
    Set wb = Workbooks.Open(Filename:=strDateiName, ReadOnly:=True, UpdateLinks:=0)
    
    Application.StatusBar = "Bearbeite Datei """ & strDateiName & """"
    'Alle Tabellenblätter in Mappe abarbeiten
    For Each tbl In wb.Worksheets
        
        'Nächste frei zeile im Ergebnisblatt
        lngZeile_E = fncNextFreeRow(wks:=wksErg)
        If lngZeile_E > 3 Then
            lngZeile_E = lngZeile_E + 1
        End If
        
        With tbl
            'Suchbegriff suchen
            
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart)
            ', SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=True)
            
            Set rng = .UsedRange.Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
            
            If Not rng Is Nothing Then
                
                bolGefunden = True
                strFirsAddress = rng.Address
                
                'Daten in Zeile 1 kopieren - Formate und Werte
                .Range(.Cells(5, 1), .Cells(5, 130)).Copy
                
                Do
                    
                    With wksErg
                        '.Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteFormats
                        .Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteValues
                        .Cells(lngZeile_E, 1).Value = varSuchen
                        .Cells(lngZeile_E, 2).Value = wb.Name
                        .Cells(lngZeile_E + 1, 2).Value = tbl.Name
                    End With
                    
                    'Daten in gefundener Zeile kopieren - Formate und Werte
                    .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 130)).Copy
                    
                    With wksErg.Cells(lngZeile_E + 1, 4)
                        .PasteSpecial Paste:=xlPasteFormats
                        .PasteSpecial Paste:=xlPasteValues
                    End With
                    
                    lngZeile_E = lngZeile_E + 1
                    
                    Set rng = .UsedRange.FindNext(After:=rng)
                    
                Loop Until rng.Address = strFirsAddress
            End If
        End With
        Application.CutCopyMode = False
    Next tbl
    'Datei ohne Speichern schließen
    wb.Close savechanges:=False
    Application.StatusBar = False
End Sub

Gruß
Nepumuk
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 15:38:29
Ahrens
Hallo Nepumuk,
Danke für Deine schnelle Reaktion.
Das sieht sehr gut aus und funktioniert auch "fast" so wie ich es mir wünsche.
Schön wäe jetzt noch, wenn in der Spalte B bei den Suchergebnissen immer vor dem Treffer der Name des Tabellen Blattes steht. Irgendwie überschreibt der bei mir immer die Tagellen-Blatt-Bezeichnung durch den dateinamen und schreibt nur vor dem letzten Treffer den Namen des Tabellen-Blattes.
Danke im Voraus.
Gruß
Frank
AW: Problem mit "Weitersuchen"
28.09.2020 15:50:26
Nepumuk
Hallo Frank,
so besser?
Sub prcAktion(ByVal strDateiName As String)
    Dim rng As Range
    Dim tbl As Worksheet
    Dim wb As Workbook
    Dim strFirsAddress As String
    
    'Datei schreibgeschützt öffnen
    Set wb = Workbooks.Open(Filename:=strDateiName, ReadOnly:=True, UpdateLinks:=0)
    
    Application.StatusBar = "Bearbeite Datei """ & strDateiName & """"
    'Alle Tabellenblätter in Mappe abarbeiten
    For Each tbl In wb.Worksheets
        
        'Nächste frei zeile im Ergebnisblatt
        lngZeile_E = fncNextFreeRow(wks:=wksErg)
        If lngZeile_E > 3 Then
            lngZeile_E = lngZeile_E + 1
        End If
        
        With tbl
            'Suchbegriff suchen
            
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlWhole)
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart)
            ', SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
            'Set rng = .Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=True)
            
            Set rng = .UsedRange.Find(What:=varSuchen, After:=.Range("A1"), LookIn:=xlValues, LookAt:=xlPart)
            
            If Not rng Is Nothing Then
                
                bolGefunden = True
                strFirsAddress = rng.Address
                
                'Daten in Zeile 1 kopieren - Formate und Werte
                .Range(.Cells(5, 1), .Cells(5, 130)).Copy
                
                With wksErg
                    '.Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteFormats
                    .Cells(lngZeile_E, 4).PasteSpecial Paste:=xlPasteValues
                    .Cells(lngZeile_E, 1).Value = varSuchen
                    .Cells(lngZeile_E, 2).Value = wb.Name
                    .Cells(lngZeile_E + 1, 2).Value = tbl.Name
                End With
                
                Do
                    
                    'Daten in gefundener Zeile kopieren - Formate und Werte
                    .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 130)).Copy
                    
                    With wksErg.Cells(lngZeile_E + 1, 4)
                        .PasteSpecial Paste:=xlPasteFormats
                        .PasteSpecial Paste:=xlPasteValues
                    End With
                    
                    lngZeile_E = lngZeile_E + 1
                    
                    Set rng = .UsedRange.FindNext(After:=rng)
                    
                Loop Until rng.Address = strFirsAddress
            End If
        End With
        Application.CutCopyMode = False
    Next tbl
    'Datei ohne Speichern schließen
    wb.Close savechanges:=False
    Application.StatusBar = False
End Sub

Gruß
Nepumuk
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 16:37:38
Ahrens
Hallo Nepumuk,
Da sieht sehr, seht gut aus. So schön kann Excel sein.
Wenn man wie Du Ahnung hat, aber deswegen binn ich mir ja nich zu Schade Spezialisten zu fragen.
Das Ergebnis ist so wie ich mir da vorgestellt habe.
Vielleicht könntest du mir aber noch einen Tipp geben, wie ich bei der Suche die Spalte "E" (5. Spalte) in den zu durchsuchenden Excel-Arbeitsmappen (deren Excel-Tabellen ausschliesen kann?
In dem Feld steht die Mail-Adresse und die hat oft den Normalen oder den Firmennamen im Inhalt.
Da die Suche aber über "LookAt:=xlPart" läuft, wird der Teilstring eventuell in einer Zeile mehrfach gefunden. Somit sind dann eventuell mehrer Treffer in einer Zeile möglich. Oder aber was eventuell auch eine Möglichkeit wäre dass man die Suche auf die esrten 4 Spalten begrenzt.
Nur wie setzt man dass um?
Gruß
Frank
Anzeige
AW: Problem mit "Weitersuchen"
28.09.2020 16:46:19
Nepumuk
Hallo Frank,
so:
Set rng = .Columns("A:D").Find(....
Set rng = .Columns("A:D").FindNext(After:=rng)
Gruß
Nepumuk
AW: Problem mit "Weitersuchen"
28.09.2020 17:02:37
Ahrens
Hallo Nepumuk,
Danke das ist genau die Lösung.
Das Ergebnis ist jetzt genau so, wie ich es mir vorgestellt habe.
Du hast mir meinen Abend gerettet.
;-)
Also nochmals ein grosses DANKE für die schnelle Hilfe
Gruß und schönen Abend noch.
Frank
AW: Problem mit "Weitersuchen"
28.09.2020 16:20:37
Ahrens
Hallo Nepumuk,
Danke für Deine schnelle Reaktion.
Das sieht sehr gut aus und funktioniert auch "fast" so wie ich es mir wünsche.
Schön wäe jetzt noch, wenn in der Spalte B bei den Suchergebnissen immer vor dem Treffer der Name des Tabellen Blattes steht. Irgendwie überschreibt der bei mir immer die Tagellen-Blatt-Bezeichnung durch den dateinamen und schreibt nur vor dem letzten Treffer den Namen des Tabellen-Blattes.
Danke im Voraus.
Gruß
Frank
Anzeige

300 Forumthreads zu ähnlichen Themen

@Hans W. Herber: 1 Million Beiträge - Glückwunsch
mpb

Hallo Hans,
wenn ich die URLs richtig interpretiere, haben wir im Forum soeben die Zahl von 1 Million Beiträgen überschritten.
Herzlichen Glückwunsch zu dem Erfolg Deines "Babys"!
Gruß
Martin
07.08.2008 16:23:47
Thread-ID: 1000004
3 Beiträge
Anzeige
Frage - Spalten einfügen & Spalten untereinander z
André

Hallo zusammen!
Ich habe da als blutiger Anfänger in VBA zwei Fragen:
1.) Wie kann ich in meiner Tabelle in jeder zweiten Spalte 4 leere Spalten einfügen lassen?
2.) Dann möchte ich unter den Inhalt der ersten fünf Spalten (A-E) den Inhalt der zweiten 5 Spalten (F-J) usw. In der grö...
08.08.2008 16:00:00
Thread-ID: 1000340
3 Beiträge
Zellen mit Werten aus darüberliegender Zelle fülle
Andreas

Guten Morgen!
Ich hätte folgendes Problem: Ich erhalte automatisiert Exceltabellen, bei denen nicht alle Zellen einer Zeile gefüllt werden, wenn dort der Inhalt einer darüberliegenden Zeile stehen sollte. Zur Weiterverarbeitung muss ich aber diese Zellen mit den dazugehörigen Werten füllen....
11.08.2008 08:59:25
Thread-ID: 1000713
4 Beiträge
Anzeige
Zellen formatieren mit vorangehenden "Nullen"
Addi

Hallo zusammen,
ich habe eine lange Liste, in der in einer Spalte Daten stehen, wo ab und zu vorangehende Nullen nötig sind (mal eine - mal 2...etc.) - und manchmal auch keine.
Wie kann ich diese Zellen formatieren, das die vorangehenden "Nullen" nicht automatisch weggelassen werden?
11.08.2008 10:37:00
Thread-ID: 1000746
8 Beiträge
Makro beenden bei Option "Schliessen"
Jürgen

Hallo Excel-Profis
ich habe folgenden Code in ein Makro eingebaut:
'Drucken mit Vorschau
Application.ActivePrinter = "\\dataserv\HP LaserJet 5L AV auf Ne05:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True, Collate:= _
True
Hier wird der Standard-Drucker an...
11.08.2008 12:39:00
Thread-ID: 1000811
9 Beiträge
Zellen prüfen / Ausgabe wenn Bedingung erfüllt
Kay

Hallo,
Ich brauche dringend Eure Hilfe. Unter https://www.herber.de/bbs/user/54533.xls findet Ihr eine Mappe, in welcher in Spalte A
1 für "Kaufen"
0 für " "
-1 für "Verkaufen"
steht. IN SPALTE B SIND BISHER NUR MANUELL ERSTELLTE BEISPIELEINTRÄGE ENTHALTEN, DAMIT ERSICHTLIC...
12.08.2008 09:51:36
Thread-ID: 1001078
3 Beiträge
"Bild von Excel-Kamara" variabel...
Excel-Kamara"

Hi Experten,
einen Bereich (Zellen, Bild, Grafik...) mit der Excel-Kamara "fotografieren" und in eine andere Excelmappe einfügen ist kein Problem.
Bei mir werden Ecxel_Vorlagen ausgefüllt und unter fortlaufender Dateinummer abgespeichert, zB. QR000123, QR000124, QR000125 usw. Alle Datei...
12.08.2008 10:33:28
Thread-ID: 1001116
4 Beiträge
Formel "Text" ROTE Zahl bei Minuswert?
dieter(drummer)

Hi Formelspezialisten,
in Zelle B2 steht dise Formel (funktionert auc h):
=TEXT(I4-D4;"00.0")&" ("&TEXT(I4/D4-1;"0%")&")".
Mein Ziel, dass eine Minuszahl in ROT erscheint. Hab's mit bedingte Formatierung versucht und bekomme es nicht hin.
Gibt es eine Möglichkeit, a...
12.08.2008 10:59:29
Thread-ID: 1001135
7 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
2
7
2
3
1
7
8
2
3
6
11
5
5
8
15
3
7
4
4
3
2
7
4
3
4