Excel vba: Suchmechanismus

[sharky51]

Hi Attila,

das ist ne gute Idee und ich habe auch noch eine  

Das Ziel ist es ja aus der Gesamtanzahl der Datenstrings eine Untermenge zusammenzusuchen/zusammenzustellen.
Schön wäre es einen Zähler zu haben der die Fundstellen zählt und in der Dialogbox ausgibt. Diese Anzahl sollte auch nach einer Filterung angezeigt werden.
Also einfach die Anzahl wie viele Fundstellen ermittelt wurden und die gleiche Kdn-/Bestell-Nr. in Spalte "B" eingetragen wurde.

Dies würde die Spalte "F" ersetzen, denn da sehe ich nach einer Filterung die Anzahl der gesuchten Fundstellen.

Ich hoffe ich habe das nicht wieder zu kompliziert beschrieben.

[DbSam]

Hallo Ihr zwei Mitkämpfer,  :)

Ihr dürft loslegen, wie verrückt.
Ich schnall mir dann die Gummisocken an und mache mich auf an den Rhein. Bis Donnerstagabend habt Ihr Ruhe vor mir.

@Erich:
Ganz ehrlich? Schmeiß die beiden Spalten raus.
Die Zeile steht vorn im Sheet und die Anzahl bekommst Du unten links in der Statuszeile mitgeteilt.
Zusätzlich auch im Userform, wenn Du folgendes machst:

Lösche die Sub "Private Sub SetFilter(Optional Value As Integer = 0)"

Code:

'die alte Sub komplett mit dieser ersetzen:

Private Sub SetFilter(Optional Value As Integer = 0)
On Err GoTo Er
   Dim i As Long, rowsCount As Long
       
   With Sheets(Me.MySheetName)
       If .AutoFilterMode Then .AutoFilterMode = False
       
       If Value <> 0 Then
           i = Value
       Else
           i = GetFilterSetting
       End If
       
       'Anzahl vor dem filtern merken:
       rowsCount = Me.MyLastCell - Me.MyFirstDataRow + 1
       
        Select Case i
            Case 1
                .Range(Me.MyFirstColumn & Me.MyFirstDataRow - 1 & ":" & Me.MyLastColumn & _
                    Me.MyLastCell).AutoFilter Field:=Column2Nr(Me.MyDmcCodeColumn), Criteria1:=Me.MySearchString
                i = GetRows(.Range(Me.MyFirstColumn & Me.MyFirstDataRow - 1 & ":" & Me.MyLastColumn & Me.MyLastCell))
                ListEntryAdd "Filter ""DMC-Code"", Suchbedingungen: Datum: " & Me.txtDate & _
                    ",  Suchstring: " & Me.txtSearchString & vbTab & i & " von " & rowsCount & " gefunden"
                Application.Goto Reference:=.Cells(Me.MyRowNumber, Me.MyFirstColumn), Scroll:=True
            Case 2
                .Range(Me.MyFirstColumn & Me.MyFirstDataRow - 1 & ":" & Me.MyLastColumn & _
                    Me.MyLastCell).AutoFilter Field:=Column2Nr(Me.MyOffset1Column), Criteria1:=Me.MyOutputString
                i = GetRows(.Range(Me.MyFirstColumn & Me.MyFirstDataRow - 1 & ":" & Me.MyLastColumn & Me.MyLastCell))
                ListEntryAdd "Filter ""Kdn-/Bestell-Nr"", Suchbedingung: " & Me.txtNumber & _
                    vbTab & i & " von " & rowsCount & " gefunden"
                Application.Goto Reference:=.Cells(Me.MyRowNumber, Me.MyFirstColumn), Scroll:=True
            Case Else
                .Range(Me.MyFirstColumn & Me.MyFirstDataRow - 1 & ":" & Me.MyLastColumn & Me.MyLastCell).AutoFilter
        End Select
   End With
Ex:
   Application.ScreenUpdating = True
   Exit Sub
Er:
   Application.ScreenUpdating = True
   MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "Fehler in SearchAndSetNumber"
   Resume Ex
   'for debug:
   Resume Next
End Sub

'und zusätzlich noch diese Funktion neu einfügen:
Private Function GetRows(ByVal MyRange As Range) As Long
   'Error, wenn es keine sichtbaren Zellen gibt. Deshalb:
   On Error Resume Next
   GetRows = MyRange.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
End Function

Das Ergebnis sieht in etwa so aus:
   
Da kannst Du nochmal nachträglich nachschauen/kontrollieren. Damit sollten die beiden Kummer machenden Spalten entfallen können. (Auch wenn Du Dir für die Formeln vielleicht viel Mühe gegeben haben solltest ...)


@Atilla:
Leg los, Du darfst.
In .Net legt man einfach ein Objekt in den Tag des ListItems und fertig.
Geht hier in VBA meines Wissens nicht so. Ich würde der Einfachheit halber neben der Liste eine Collection füllen und das Objekt mit dem Listindex aufrufen.
Vielleicht hast Du eine bessere Idee.
Und reinschauen tu ich schon mal ... ;)


Bis denne,
Gruß Carsten


;)


Edit:
Wieder mit Erichs Posting überschnitten :D
Habe zu lange benötigt.

Erich, reicht das so aus?

[sharky51]

Guten Abend Carsten,

danke für die weiteren Verbesserungen.
Mann ist das genial, einfach genial!!!!  :18:

Mir fehlen die Worte - manchmal -

[atilla]

@Atilla:
Leg los, Du darfst.
In .Net legt man einfach ein Objekt in den Tag des ListItems und fertig.
Geht hier in VBA meines Wissens nicht so. Ich würde der Einfachheit halber neben der Liste eine Collection füllen und das Objekt mit dem Listindex aufrufen.
Vielleicht hast Du eine bessere Idee.
Und reinschauen tu ich schon mal ... ;)

Hallo Carsten,

nee, so war das nicht gemeint.
Ich habe gerade auch nicht viel Zeit.
Aber lösen kann man das sehr einfach, indem man die Listbox zweispaltig macht. Die Spaltenbreite kann dann in der zweiten auf 0 gesetzt werden. Dort liest man die Zeile ein und aus. Ist kein großer Aufwand.

Also Erich, dann musst Du Dich etwas gedulden, bis Carsten den Rhein gesäubert hat, wie auch immer.

[sharky51]

Tue ich, tue ich ....

[snb]

Ich verstehe die ganze Codemenge nicht.

[DbSam]

Hallo snb,

Ich verstehe die ganze Codemenge nicht.

... ich auch nicht.

Wächst halt.
Schrumpft auch manchmal wieder.
Wie immer am Bau ...





Gruß Carsten
:)


PS:
Hallo Erich,
habe über die Pausen etwas bereinigt und  Fehler korrigiert ...
Habe noch zwei Testsheets zur Demo und  zum Test mit unterschiedlich aufgebauten Tabellen integriert.

  ErichsSuche_V7.2_Work.xlsm (Größe: 100,55 KB / Downloads: 3)

[sharky51]

Hallo Carsten,

muss mir Deine neue Version in Ruhe zu Gemüte führen um zu verstehen was Du da alles gezaubert hast.

[DbSam]

Hallo Erich,

da ist nichts Neues eingebaut, nur aufgeräumt und die Liste mit Spalten versehen.
Die zwei Testsheets dienen nur der Demo, dass dieses Userform auch mit späteren Änderungen an Deiner Tabelle zurechtkommt. Man muss nur den Aufruf anpassen, wie Du sicherlich letztens schon bemerkt hast.


Gruß Carsten


Edit:
Habe eben entdeckt, dass ich gestern das Steuerelement zum Löschen des Suchstrings im Code vergessen hatte.
Ist korrigiert:

  ErichsSuche_V7.4_Work.xlsm (Größe: 100,83 KB / Downloads: 1)

[sharky51]

Hallo Carsten,

danke nochmals für Deine weiteren Bemühungen.

Ich werde die nächsten Tage mal ausgiebig testen.
Vielleicht fällt mir noch etwas ein was ganz ganz dringend benötigt wird.  :19: