Variable Suche, Spalten über Userform de

Forumthread: Variable Suche, Spalten über Userform de

07.11.2020 15:19:30

Curly

Hallo,
ich würde gerne eine variable Suche einbauen, in der man über eine Userform bestimmen kann, welche Spalten durchsucht werden sollen.
In meinem Beispiel möchte ich nicht im Lagerort1 sondern nur im Lagerort2 nach "A10" suchen (und in allen andern Spalten)
Leider habe ich nicht rausgefunden, wie ich mein Range so zusammen setzen kann das nur dann Spalte 1-2, 4-7 gesucht wird.
Oder eben in Spalte 1,2,4,7 ...
Meine Versuche mit Union etc sind leider nicht von Erfolg gewesen.
https://www.herber.de/bbs/user/141388.xlsm
Vielen Dank vorab
Gruß Curly

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Variable Suche, Spalten über Userform de

07.11.2020 16:46:54

Nepumuk

Hallo Curly,
teste mal:

Option Explicit

Sub Search()

    Dim c As Range
    Dim lngZeile As Long
    Dim rngBereich As Range
    Dim lngAnzahl As Long
    Dim strFirst As String
    Dim arrStock As Variant
    Dim i, ii, X As Byte
    Dim iAnzahl As Integer
    Redim vTemp(0 To 6, 0 To 100) As Variant
    Dim iIndx As Integer
    Dim AnzahlBetriebe As Integer
    Dim iSuche As Integer
    Dim lngIndex As Long

    UserForm1.ListBox1.Clear

    arrStock = Array("StockA", "StockB", "StockC")

    For i = LBound(arrStock) To UBound(arrStock)
        With Sheets(CStr(arrStock(i)))
            Set rngBereich = Nothing
            For lngIndex = 2 To 7
                If Worksheets("Suche").Cells(lngIndex, 2).Value = "ja" Then
                    If rngBereich Is Nothing Then
                        Set rngBereich = .Columns(lngIndex - 1)
                    Else
                        Set rngBereich = Union(rngBereich, .Columns(lngIndex - 1))
                    End If
                End If
            Next lngIndex
            Set c = rngBereich.Find(UserForm1.TextBox1.Text, LookIn:=xlValues, LookAt:=xlPart)
            If Not c Is Nothing Then
                strFirst = c.Address
                Do
                    ' If c.Row = lngZeile Then GoTo naechste

                    vTemp(0, iAnzahl) = arrStock(i)
                    For iIndx = 1 To 6
                        vTemp(iIndx, iAnzahl) = .Cells(c.Row, iIndx)
                    Next iIndx
                    iAnzahl = iAnzahl + 1
                    ' lngZeile = c.Row

                    naechste:
                    Set c = rngBereich.FindNext(c)
                Loop While Not c Is Nothing And c.Address <> strFirst
            End If
        End With

    Next i

    If iAnzahl = 0 Then
        MsgBox "Es wurde keine Treffer gefunden!", vbInformation, "Hinweis"
        GoTo ende
    End If

    Redim arrTemp(0 To 6, 0 To iAnzahl - 1)
    Redim Preserve vTemp(0 To 6, 0 To iAnzahl - 1)

    If (iAnzahl - 1) = 0 Then
        Redim arrTemp(1 To 1, 0 To 6)
        For i = 0 To 6
            arrTemp(1, i) = vTemp(i, 0)
        Next i
    Else
        arrTemp = WorksheetFunction.Transpose(vTemp)
    End If

    UserForm1.ListBox1.List() = arrTemp

    ende:
    Erase vTemp
    Erase arrTemp

End Sub

Gruß
Nepumuk

Perfekt - Danke

07.11.2020 16:52:43

Curly

Hallo Nepumuk,
ein Wort "Perfekt" , genau so wie ich das wollte.
Vielen Dank und ein Schönes Wochenende :-D
Gruß Curly

AW: Variable Suche, Spalten über Userform de

09.11.2020 20:57:39

Curly

Hallo Nepumuk,
eventuell könntest du mir noch einmal helfen, und zwar habe ich jetzt in der "großen" Datei festgestellt, dass wenn ich auf den Button "suchen" in der Userform klicke, kommen die Werte in der Listbox nach dem WorksheetFunction.Transpose, in Deutscher Schreibweise an.
lass ich allerdings das Suchfeld von einem Script befüllen und die Suchroute ebenfalls durch "Call Search" ausführen, kommen die werte nach WorksheetFunction.Transpose auf Englischer Schreibweise raus.
Leider lässt sich das Problem in der kleinen Beispielmappe nicht darstellen.
irgendwie sehr merkwürdig.
Vielen Dank schönen Abend
Curly

AW: Variable Suche, Spalten über Userform de

09.11.2020 21:28:45

Nepumuk

Hallo Curly,
teste mal:

Option Explicit

Public Sub Search()

    Dim objCell As Range, objRange As Range
    Dim objDictionary As Object
    Dim avntValues() As Variant, vntItem As Variant
    Dim lngIndex As Long, ialngIndex As Long, lngColumn As Long
    Dim strFirstAddress As String

    UserForm1.ListBox1.Clear

    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")

    For Each vntItem In Array("StockA", "StockB", "StockC")

        With Worksheets(vntItem)

            Set objRange = Nothing

            For lngIndex = 2 To 7
                If Worksheets("Suche").Cells(lngIndex, 2).Value = "ja" Then
                    If objRange Is Nothing Then
                        Set objRange = .Columns(lngIndex - 1)
                    Else
                        Set objRange = Union(objRange, .Columns(lngIndex - 1))
                    End If
                End If
            Next

            Set objCell = objRange.Find(UserForm1.TextBox1.Text, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

            If Not objCell Is Nothing Then

                strFirstAddress = objCell.Address

                Do

                    If objCell.Row > 1 Then

                        If Not objDictionary.Exists(Key:=vntItem & "|" & objCell.Row) Then

                            Call objDictionary.Add(Key:=vntItem & "|" & objCell.Row, Item:=vbNullString)

                            Redim Preserve avntValues(6, ialngIndex)

                            avntValues(0, ialngIndex) = vntItem

                            For lngColumn = 1 To 6
                                avntValues(lngColumn, ialngIndex) = .Cells(objCell.Row, lngColumn)
                            Next

                            ialngIndex = ialngIndex + 1

                        End If
                    End If

                    Set objCell = objRange.FindNext(After:=objCell)

                Loop Until objCell.Address = strFirstAddress
            End If
        End With

    Next

    If ialngIndex = 0 Then
        MsgBox "Es wurde keine Treffer gefunden!", vbInformation, "Hinweis"
    Else
        UserForm1.ListBox1.Column = avntValues
    End If
End Sub

Gruß
Nepumuk

AW: Variable Suche, Spalten über Userform de

09.11.2020 23:46:53

Curly

Hi Nepumuk,
wieder vielmals danke, das Datum bleibt jetzt auf "deutscher" Schreibweise, das ist sehr gut,
aber leider wird der Warenwert (nur) als Zahl dargestellt, ohne - Zeichen, bekommt man das auch noch irgendwie hin?
Gibt es einen Grund warum Excel das so macht?
Vielen Dank & gute Nacht :-D
Gruß Curly

AW: Variable Suche, Spalten über Userform de

10.11.2020 00:05:50

Curly

kann man den Code so erweitern:


If ialngIndex = 0 Then
MsgBox "Es wurde keine Treffer gefunden!", vbInformation, "Hinweis"
Else
For lngIndex = LBound(avntValues, 2) To UBound(avntValues, 2)
avntValues(6, lngIndex) = Format(avntValues(6, lngIndex), "#,##0.00 ")
avntValues(7, lngIndex) = Format(avntValues(7, lngIndex), "#,##0.00 ")
Next lngIndex
UserForm1.ListBox1.Column = avntValues
End If

oder gäbe es eine bessere Lösung?

AW: Variable Suche, Spalten über Userform de

10.11.2020 08:45:40

Nepumuk

Hallo Curly,
ich würde das direkt bei der Übergabe der Zellwerte an das Array machen:

For lngColumn = 1 To 6
avntValues(lngColumn, ialngIndex) = .Cells(objCell.Row, lngColumn).Text
Next

Gruß
Nepumuk

AW: Variable Suche, Spalten über Userform de

10.11.2020 09:30:55

Curly

DU bist echt Super. Vielen Dank
was das kleine Wort .Text doch so alles bewirken kann.
Ich wünsch dir einen schönen Tag.
Gruß Curly

AW: Variable Suche, Spalten über Userform de

07.11.2020 17:14:24

onur

Warum so kompliziert?
https://www.herber.de/bbs/user/141392.xlsm

AW: Variable Suche, Spalten über Userform de

09.11.2020 19:42:44

Curly

Danke onur,
Man lernt nie aus ...
Gruß Curly

Beliebteste Forumthreads (12 Monate)

Variable Suche, Spalten über Userform de

Forumthread: Variable Suche, Spalten über Userform de

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread