Suchen in Spalte A

[AndreLieske]

Hallo Gast 123,
die Artikelnummer die dazwischen liegen, werden nicht mehr ausgegeben.
A1495-A1501/140
zB. A1496

[AndreLieske]

Hallo snb,
weil es nicht so Einfach ist,
die Zahlen die zwischen den Artikelnummern liegen, sollen auch ein Treffer geben und den Artikel anzeigen.
A1495-A1501/140
Also A195 bis A1501
z.B Suche nach A 1496

[Egon12]

Hallo André,

hier mein Lösungsvorschlag. Baue eine Active-X Textbox ins Tabellenblatt

ins Modul des Tabellenblattes:

Code:

Private Sub TextBox1_Change()
    WerteFinden
End Sub

in ein allgemeines Modul:

Code:

Option Explicit

Sub WerteFinden()
    Dim min&, max&, i&, j&, var
    With Tabelle1
        If Len(.TextBox1) < 2 Then Exit Sub
        For i = 18 To .Cells(Rows.Count, 1).End(xlUp).Row
            var = Replace(.Cells(i, 1), "a", "", 1, 2, vbTextCompare)
            min = Left(var, InStr(var, "-") - 1)
            max = Right(var, InStr(var, "-") - 1)
            For j = min To max
                If Replace(.TextBox1, "a", "", , , vbTextCompare) >= min And Replace(.TextBox1, "a", "", , , vbTextCompare) =< max Then
                    .Range("A" & i & ":K" & i).Interior.Color = vbYellow
                Else
                    .Range("A" & i & ":K" & i).Interior.ColorIndex = xlNone
                End If
            Next j
        Next i
    End With
End Sub

Wenn ein Wert gefunden wird, färbt sich die Zeile des Treffers gelb.
Diese Lösung scheint mir der komfortabelste Weg diese Anfrage zu sein. Deine Testdatei mit den Änderungen anbei.

  ED2024.xlsm (Größe: 51,67 KB / Downloads: 3)

Gruß Uwe

[snb]

Warum suchen nach A1496, die es nicht gibt ???

[Gast 123]

Hallo Andre

wenn man eine "schlaue Idee hat", aber als Programmierer nicht an alles denkt, schleichen sich dumme Fehler ein!
Dein Wunsch bezüglich dieser Zeilen veranlasste mich die Autofilter Auswertung auf - Eingabe & "*" - zu ändern!
Zeile 443   V3473-V3473/300
Zeile 444   V3473-V3473/300BB

Dabei übersah ich die Tatsache, das A1496 ja in der Artikel Nr.  A1495-A1501/140  unsichtbar versteckt ist!
Ich bewundere aufrichtig snb für seine kurzen und bekannten Einzeiler Codes. Darin ist er ein wahres Genie!
Sein Wissen und seine Fähigkeiten übersteigen bei weitem mein bescheidenes Können!  Das gebe ich offen zu.

Aber wie du es sagst, das Problem ist die versteckte Zahl in der Kombi Artikel Nr.!  Die aufspüren ist die Kunst.
Bitte ändere diesen Teil in deinem Code, damit funktioniert es bei  mir wieder. Ich hoffe es war der letzte Fehler.
Falls nein, ich bin im Forum für meine Hartnäckigkeit bekannt solange weiterzumachen bis er funktioniert.

mfg Gast 123

Code:

           For i = AZahl To EZahl
              If i = CInt(Mid(Eingabe, 2)) Then
                 Suchen = rFind.Cells(j, 1)  '** Fehler Korrektur!
                 If InStr(Suchen, "-") Then Suchen = Left(Suchen, InStr(Suchen, "-") - 1)
                 If InStr(Suchen, "/") Then Suchen = Left(Suchen, InStr(Suchen, "/") - 1)
                 Range("A17:K" & lz1).AutoFilter Field:=1, Criteria1:=Suchen & "*"
                 Exit Sub
              End If
          Next i

---

@snb   Edison machte über 3.000 Versuche, bis er eine Glühbirne erfand die wirklich funktionierte!
            Ich hoffe mein Code hat weniger Fehler!   (Spass im forum muss sein)

---

@Egon12    dein Code wird sicher laufen, ich habe ihn  nicht getestet. Dein Datei hat aber nur wenige Zeilen bis 24!
                   Meine Beispieldatei mit seinen Daten hat aber schon 661 Zeilen. Wie soll man da nach unten scrollen???
                   Andre hatte sich deshalb auch beim Beispiel für die Autofilter Methode entschieden.

[AndreLieske]

Hallo Gast 123,

vielen vielen DANK
Was ich bisher getestet habe, funktioniert SUPER
Ich lasse das Thead noch offen, für den Fall, das doch noch was ist.
Noch einmal DANKE

@ALL
Mochte mich bei allen, die mir Produktiv geholfen bedanken.

[Gast 123]

Hallo Andre

noch mal eine kleine Korrektur, nachdem ein freundlicher Kollege doch noch einen Fehler entdeckt hat.  Danke dafür!
Gib bitte mal V4020 ein, da kommt die Fehlermeldung "Artikel exisitiert nicht!"  Mit Eingabe V40 wird er aber angezeigt!
Um den Fehler abzufangen habe ich noch eine zweite Set Anweisung eingefügt. Code bitte um diesen Teil ergänzen!
Bei der For Next Schleife die danach kommt habe ich den Wert auf 10 erhöht.   
      Suchen = Empty
      For j = 1 To 10

Mfg Gast 123

Code:

    'Suche nach Kombi Artikel Nr.  (mit -)
    'letzte Stelle zum suchen abschneiden
    Suchen = Left(Eingabe, Len(Eingabe) - 1)
    If Len(Eingabe) = 3 Then Suchen = Eingabe
    If rFind Is Nothing Then _
    Set rFind = Range("A2:A" & lz1).Find(What:=Suchen, After:=[a2], LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
   
    'zweite Stelle zum suchen abschneiden
    Suchen = Left(Eingabe, Len(Eingabe) - 2)
    If rFind Is Nothing Then _
    Set rFind = Range("A2:A" & lz1).Find(What:=Suchen, After:=[a2], LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

[snb]

Alternative ?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$E$4" And Target <> "" Then ListObjects(1).DataBodyRange.AutoFilter 1, Cells(17 + Application.Match(Target, [A18:A661], 1), 1)
End Sub

[AndreLieske]

Hallo Gast 123,
auch das funktioniert, vielen Dank

[Gast 123]

Hallo Andre

ich habe mir erlaubt den Code von snb etwas zu erweitern.  Um lz1 und Autofilter = False
Mein Beispiel enthält keine Intelligente Tabelle, deshalb nahm ich den normalen Autofilter.
Beim löschen von F4 wird der Autofilter wieder abgeschaltet. Das war vorher nicht so.

Mit lz1 kann sich die Tabelle beliebig nach unten erweitern, was bei einer Intelligenten Tabelle automatisch erfolgt.
Der Code von snb ist faszinierend einfach, er ist im Forum berühmt für seine Einzeiler Lösungen.
Ich habe nicht alles getestet. und noch nicht verstanden wie sein Code funktioniert!!  Toller Programmierer.
Du kannst ihn ja mal selbst testen. Viel Spass beim testen.

mfg Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If InStr(Target.Address, ":") Then Exit Sub
  'Lösung von snb!  (um lz1 und Target = Empty erweitert)
  If Target.Address = "$E$4" And Target <> "" Then
     lz1 = ActiveSheet.UsedRange.Rows.Count
'     ListObjects(1).DataBodyRange.AutoFilter 1, Cells(17 + Application.Match(Target, Range("A18:A"& lz1), 1), 1)
     Range("A17:K" & lz1).AutoFilter 1, Cells(17 + Application.Match(Target, Range("A18:A" & lz1), 1), 1)
  ElseIf Target = Empty Then ActiveSheet.AutoFilterMode = False
  End If:  Target.Select
End Sub