Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

Externe Datei filtern


Betrifft: Externe Datei filtern von: RaGru
Geschrieben am: 04.07.2017 18:28:49

Hallo.
Vorweg: Dieses Forum hat mir schon bei vielen Problemchen und Problemen weiter geholfen und da meine Kenntnisse in Excel und Excel-VBA auf try&error aufbauen kommen da schon ein paar zusammen ;) ...dafür schon mal Danke!

Nun habe ich ein vermutlich größeres Problem:
Ich bekomme täglich eine Exceldatei von einem Programm. In dieser Datei sind grob 38.000 Artikel eingetragen. Ein Artikel pro Zeile und 184 Spalten mit Informationen.

Diese Datei lasse ich von einer anderen Exceldatei mittels Makro stark einkürzen auf ca. 8.000 Artikel und ca. 20 Spalten. Mit dieser Datei ("Name2") arbeite ich täglich.

Nun möchte ich von einer weiteren Datei("Verwaltung") die Datei "Name2" öffnen und alle Spalten außer denen mit dem gesuchten Wert ausblenden.

Wie folgt gelöst:
Öffnen:

With exneu 'New Excel Application
Set Name2 = .Workbooks.Open("Pfad mit Datei", UpdateLinks:=False, ReadOnly:=True, Password:=" _
Password")
               .Visible = True
End With
Und dann das filtern:
Do While Z < 100
If Artikel.Cells(Z, S).Value = "0" Then
    Artikel.Cells(Z, S).EntireRow.Hidden = True
Else
    If Not Artikel.Cells(Z, S).Value = "Gesuchter Wert" Then
        If Not Artikel.Cells(Z, S).Offset(0, 1).Value = "Gesuchter Wert" Then
            If Not Artikel.Cells(Z, S).Offset(0, 2).Value = "Gesuchter Wert" Then
                If Not Artikel.Cells(Z, S).Offset(0, 3).Value = "Gesuchter Wert" Then
                    If Not Artikel.Cells(Z, S).Offset(0, 4).Value = "Gesuchter Wert" Then
                        If Not Artikel.Cells(Z, S).Offset(0, 5).Value = "Gesuchter Wert" Then
                            If Not Artikel.Cells(Z, S).Offset(0, 6).Value = "Gesuchter Wert"  _
Then
                                Artikel.Cells(Z, S).EntireRow.Hidden = True
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End If
Z = Z + 1
Loop

..."Gesuchter Wert" entspringt als String einer Inputbox in Datei "Verwaltung"
...Artikel ist der Worksheet in Datei "Name 2"

Ja, der Code ist nicht vollständig, bei Bedarf reiche ich ihn nach.

Zur Erklärung:
Der Code prüft Zelle 5 der ersten Spalte auf den Wert "0" ist hier eine Null, kommt in den Spalten danach auch nix mehr. Wenn > "0" dann durchsucht der Code Spalte 5 bis 11 nach dem gesuchten Wert, ist dieser nicht gegeben, dann wird die Zeile ausgeblendet.

Zum Problem:
Mein Code funktioniert einwandfrei so lange ich die Artikel auf 100 begrenze. Hat dann auch optisch einen hübschen Effekt.
Ich möchte aber alle 8.000 Artikel durchlaufen und dafür ist diese Methode eindeutig nicht der richtige Weg.

Wo und wie muss ich neu ansetzen um die bestmögliche Geschwindigkeit zu erreichen ?
Ein Array? Wenn Ja, wie?

Für jeden Denkanstoß und wenn möglich mit Beispiel bin ich dankbar.

Grüße,
RG

  

Betrifft: ich hab keine Idee, aber... von: Oberschlumpf
Geschrieben am: 04.07.2017 19:39:21

Hallo

...ist eine Bsp-Datei mit ausreichend vielen Bsp-Datenzeilen + -spalten bestimmt sehr hilfreich nach der Suche einer Antwort zu deinen Fragen.

Ich bin ziemlich sicher (bei mir am sichersten :-) ), dass niemand Lust hat, anhand deiner Beschreibung eine Datei nachzubauen, mit der dann (vielleicht) eine Lösung gefunden wird.

Viele Grüße
Thorsten


  

Betrifft: AW: ich hab keine Idee, aber... von: Max2
Geschrieben am: 05.07.2017 00:04:11

Hallo,

Du benutzt sehr viele IF's, das solltest du vermeiden.

Ich werde mich morgen mal ein wenig mehr damit auseinander setzen und dir ein entweder code teile oder einen ganzen code zukommen lassen.


  

Betrifft: AW: Externe Datei filtern von: RaGru
Geschrieben am: 04.07.2017 20:13:34

Hallo

...ich musste sie etwas umbauen, sollte aber funktionieren.

https://www.herber.de/bbs/user/114697.xlsx


  

Betrifft: AW: Externe Datei filtern von: Max2
Geschrieben am: 05.07.2017 08:27:24

Hallo,

hier deine Mappe(den Sub "HideRows" starten): https://www.herber.de/bbs/user/114703.xlsm

Hier nur der Code:

Option Explicit
Private ws As Worksheet

'//Sucht im Bereich E bis K nach Suchwert
Private Sub FindInputInRow(ByVal cRow As Long, userInput As Variant)

Dim rng As Range, c

    With ws
        
        Set rng = .Range(.Cells(cRow, 5), .Cells(cRow, 11))
        With rng
            Set c = .Find(userInput, LookIn:=xlValues)
            If Not c Is Nothing Then c.EntireRow.Hidden = True
        End With
            
    End With

    Set rng = Nothing: Set c = Nothing

End Sub


'//holt sich den User Input
Private Function GetInput() As Variant
Dim inp As Variant

    inp = Application.InputBox("Geben Sie einen Wert ein, " & vbNewLine & _
                                "nach dem gesucht werden soll:", "Suchfunktion")
    
    If inp <> "" Then GetInput = inp Else GetInput = "$err"

End Function


'//Versteckt alle Zeilen deren Wert in A gleich 0 oder
'//die gesuchten Begriff im Bereich E bis K aufweisen
'//Ruft Funktion "GetInput" auf
'//Ruft Sub "FindInputInRow" auf
Sub HideRows()
Dim userInput As Variant
Dim rng As Range, c
Dim cRow As Long
    
    '//Hol dir den Suchbegriff und prüfe ob er gültig ist
    userInput = GetInput
    If userInput = "$err" Then Exit Sub
    
    Set ws = ThisWorkbook.Sheets("Artikel")
    With ws
    
        '//Letzte Zeile in Spalte A
        cRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        '//Der Bereich der Spalte A
        Set rng = .Range(.Cells(2, 1), .Cells(cRow, 1))
        
        '//Für jede Zelle in diesem Bereich
        For Each c In rng
            
            '//Wenn Zellwert nicht "0" dann finde den Suchbegriff
            If c.Value <> "0" Then
                Call FindInputInRow(c.Row, userInput)
                
            '//ansonsten machst du die Zelle unsichtbar
            Else
                c.EntireRow.Hidden = True
            End If
        Next c
        
    End With
    
    '//Aufräumen
    Set rng = Nothing: Set ws = Nothing

End Sub
In Welchem Blatt er das macht, bzw. in welchem Workbook, musst du noch anpassen.
Ich habe den Code jetzt eben direkt in deine Beispiel Mappe geschrieben.


  

Betrifft: AW: Externe Datei filtern von: RaGru
Geschrieben am: 05.07.2017 14:51:36

Hallo Max,

vielen Dank das Du dich dem Thema annimmst. Dein Code funktioniert soweit ganz gut, außer das er die Zeile mit dem gesuchten Wert ausblendet und die anderen stehen lässt.


  

Betrifft: Ups... von: Max2
Geschrieben am: 05.07.2017 15:39:45

Sorry,

da hab ich nicht richtig gelesen.

Dann müsste dein vorhaben, hiermit realisierbar sein:

Option Explicit


Private Function GetInput() As String
Dim inp As Variant

    inp = Application.InputBox("Geben Sie einen Wert ein, " & vbNewLine & _
                                "nach dem gesucht werden soll:", "Suchfunktion")
    
    If inp <> "" Then GetInput = inp Else GetInput = "$err"

End Function


Sub HideRows()
Dim userInput As String
Dim ws As Worksheet
Dim rng As Range, c
Dim cRow As Long, i As Long
Dim counter As Byte: counter = 0
Dim curRow As Long

    userInput = GetInput
    If userInput = "$err" Then Exit Sub
    
    Set ws = ThisWorkbook.Sheets("Artikel")
    With ws
        cRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            
        For i = cRow To 2 Step -1
            If .Cells(i, 1).Value <> "0" Then
                Set rng = .Range(.Cells(i, 5), .Cells(i, 11))
                For Each c In rng
                    If c = userInput Then
                        counter = 1
                    End If
                Next c
                If counter = 0 Then .Cells(i, 1).EntireRow.Hidden = True
                counter = 0
            Else
                .Cells(i, 1).EntireRow.Hidden = True
            End If
        Next i
    
    End With

End Sub



  

Betrifft: AW: Ups... von: RaGru
Geschrieben am: 05.07.2017 16:07:59

Max, vielen Dank!
Der Code funktioniert.

Ohne deine Arbeit kritisieren zu wollen: Wenn ich mehr Geschwindigkeit beim filtern brauche, muss ich wohl zu Access wechseln, oder gibt es noch einen anderen Weg in Excel? Die Abfrage läuft grob 35min in der Originaldatei, dass kann ich den anderen Benutzern nicht antuen ;)

Trotzdem Danke!


  

Betrifft: AW: Ups... von: Max2
Geschrieben am: 05.07.2017 17:11:00

Ach du lieber Gott...

da wäre bei mir der Rechner schon lange aus dem Fenster geflogen.

Du kannst auch einfach den Wert für den Filter Programmatisch setzen.
In Theorie:
- Frage Nutzer nach Filter wert
- Ist Filter wert vorhanden?
- Falls ja, dann Wende an
- Falls nicht dann eben nicht

Problem beim Excel-Filter... es kann nur einen Geben, also eine Spalte Filter und das wars.

Eine Weitere Möglichkeit die mir einfällt ist folgende:
- Suche nach Suchwert in Spalte 5 bis 11
- Merke dir die Zeilen
- Verstecke alle Zeilen, außer die gespeicherten.

Eine Datenbank würde das sicherlich schneller und besser machen, denn da gibt es keine Redundanten Daten, die das Programm verlangsam.


  

Betrifft: AW: einfacher und schneller mit Hilfsspalte von: Daniel
Geschrieben am: 05.07.2017 17:23:57

Hi

machs doch einfach so

schreibe in neben die Tabelle eine Hilfsspalte mit dieser Formel (ich gehe mal davon aus, dass das ganze in Zeile 2 beginnt:

=IstZahl(Vergleich("gesuchter Wert";E2:K2;0))

und filtere dann mit dem Autofilter in der Spalte E nach "ungleich 0" und in der hilfsspalte nach WAHR

wenn du dann noch den "gesuchten Wert" in einer Zelle hinterlegst, kannst du schnell und einfach nach verschiedenen Begriffen suchen.

Gruß Daniel


  

Betrifft: AW: einfacher und schneller mit Hilfsspalte von: RaGru
Geschrieben am: 06.07.2017 17:15:57

Perfekt!

Daniel, besten Dank. Das filtern ist bei über 8.000 Artikeln in 6 Sekunden durch. Das ist sogar schneller als wenn ich das von dem eigentlichen Programm heraus starte (arbeitet mit einer Datenbank) da sind es grob 45 Sekunden - abhängig von den gefunden Einträgen.

Ich habe vorher schon mit dem Autofilter experimentiert, aber wie Max schon sagte, filterst du eine Spalte, interessiert der Rest nicht mehr. Auf eine Hilfsformel bin ich nicht gekommen :)

Für die die es interessiert, der Code aber umgeschrieben auf eine Datei. Einfach melden wenn Interesse an der Version mit zwei Dateien besteht:

Option Explicit

Sub Formel()
Dim Artikel As Worksheet
Dim AB As Range, Z
Dim LetzteZeile As Long
Dim Suchspalte As Long
Dim Zeile As Long
Dim Wert As String

Set Artikel = ThisWorkbook.Worksheets("Artikel")

With Artikel
    LetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
End With

Suchspalte = 28
Set AB = Artikel.Range(Cells(2, Suchspalte), Cells(LetzteZeile, Suchspalte))

Wert = "043007"

Zeile = 2

For Each Z In AB
    Z.FormulaLocal = "=IstZahl(Vergleich(" & Wert & ";E" & Zeile & ":K" & Zeile & ";0))"
    Zeile = Zeile + 1
Next Z

Artikel.Cells(1, Suchspalte).AutoFilter field:=Suchspalte, Criteria1:="WAHR" ', VisibleDropDown: _
=False

Artikel.Columns(Suchspalte).Hidden = True

End Sub



  

Betrifft: AW: einfacher und schneller mit Hilfsspalte von: Daniel
Geschrieben am: 07.07.2017 14:14:46

Hi
das ganze wird noch schneller, wenn du die Formel in einem Schritt in alle Zellen gleichzeitig schreibst.

AB.FormulaLocal =  "=IstZahl(Vergleich(" & Wert & ";E2:K2;0))"

Excel macht das mit den relativen Zellbezügen dann schon richtig.
das wird dann deutlich, wenn du die Z1S1-Bezugsart beim Schreiben der Formel verwendest:
AB.FormulaR1C1Local =  "=IstZahl(Vergleich(" & Wert & ";ZS5:ZS11;0))"

hier sieht man dann, dass die eigentliche Formel in jeder Zeile die gleiche ist und daher in einem Schritt in die Zellen geschrieben werden kann.


Gruß Daniel


Beiträge aus den Excel-Beispielen zum Thema "Externe Datei filtern"