Suchen in Datenbank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
habe selber den Code bekommen (weiß nicht mehr von wem)
bei mir funzt super, habe eine Tabelle mit über 4000 Einträge, probiers aus ob für dich was sein konnte
Eingabe über eine ImputBox (klein Größ = wurscht)

Option Explicit
Sub SuchenUndKopieren()
  Dim rng As Range, rngSearch As Range, rngFound As Range
  Dim strFirst As String, strSearch As String
  Dim lngRows() As Long, lngIndex As Long
  Dim i As Integer
  strSearch = InputBox("Bitte Suchbegriff eingeben:", "Suchen")
  ReDim lngRows(0)
  If strSearch > "" Then
    With Sheets("Songliste")         'anpassen
      If Selection.rows.Count = .rows.Count Then
        Set rng = Selection
      Else
        Set rng = .UsedRange
      End If
    End With
    
    Set rngSearch = rng.Find(what:=strSearch, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
    
    If Not rngSearch Is Nothing Then
      strFirst = rngSearch.Address
      Do
        If IsError(Application.Match(rngSearch.row, lngRows, 0)) Then
          ReDim Preserve lngRows(lngIndex)
          lngRows(lngIndex) = rngSearch.row
          lngIndex = lngIndex + 1
          
          If rngFound Is Nothing Then
            Set rngFound = rngSearch.EntireRow
          Else
            Set rngFound = Union(rngFound, rngSearch.EntireRow)
          End If
        End If
        
        Set rngSearch = rng.FindNext(rngSearch)
        
      Loop While Not rngSearch Is Nothing And strFirst > rngSearch.Address
    End If
    
      If Not rngFound Is Nothing Then
      Sheets("Tabelle11").Range("A2:D14").ClearContents 'anpassen
      rngFound.Copy Sheets("Tabelle1").Cells(2, 1)      'anpassen
       
    End If
  End If
  Set rng = Nothing
  Set rngSearch = Nothing
  Set rngFound = Nothing
'  Set objWB = Nothing
End Sub

Sub Alternativsuche() Dim Suchbegriff As String Dim Weiter Suchbegriff = InputBox("Namen einsetzen oder Kürzel und den Stern= *", "Alternative Suche") On Error GoTo fehler Cells.Find(What:=Suchbegriff, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False).Activate nochmal: Weiter = MsgBox("Weitersuchen?", vbYesNo, "Alternative Suche") If Weiter = vbYes Then Cells.FindNext(After:=ActiveCell).Activate GoTo nochmal End If Exit Sub fehler: Weiter = MsgBox("Suchbegriff nicht gefunden!", vbInformation, "Ergebnis:") End Sub

Sub Find() Dim C Dim Article As String Dim Weiter Article = InputBox("Please enter your PO number or our OC number") If Article = "" Then Exit Sub With ActiveSheet.Range("$C$3:$F$650000") Set C = .Find(Article, LookIn:=xlValues) If Not C Is Nothing Then C.Select Else MsgBox "Not found" nochmal: Weiter = MsgBox("Weitersuchen?", vbYesNo, "Alternative Suche") If Weiter = vbYes Then Cells.FindNext(After:=ActiveCell).Activate GoTo nochmal End If Exit Sub fehler: Weiter = MsgBox("Suchbegriff nicht gefunden!", vbInformation, "Ergebnis:") End If End With End Sub

Sub Find() Dim Weiter Dim Search As Range Dim Article As String Article = InputBox("Please enter your PO number or our OC number") If Article = "" Then Exit Sub Worksheets("Songliste").Range("D15:H200").Select 'Anpassen For Each Search In Selection If Search = Article Then Search.Select ActiveWindow.ScrollRow = Selection.row 'ActiveWindow.ScrollColumn = Selection.Column End If nochmal: Weiter = MsgBox("Weitersuchen?", vbYesNo, "Alternative Suche") If Weiter = vbYes Then Cells.FindNext(After:=ActiveCell).Activate GoTo nochmal End If Exit Sub Next fehler: Weiter = MsgBox("Suchbegriff nicht gefunden!", vbInformation, "Ergebnis:") End Sub

Sub Find() Dim C Dim Article As String Dim Weiter Article = InputBox("Namen einsetzen oder Kürzel und den Stern= *", "Eingabe-Box") If Article = "" Then Exit Sub With ActiveSheet.Range("$C$3:$F$650000") Set C = .Find(Article, LookIn:=xlValues) If Not C Is Nothing Then C.Select Else MsgBox "Not found" End If End With nochmal: Weiter = MsgBox("Weitersuchen?", vbYesNo, "Alternative Suche") If Weiter = vbYes Then Cells.FindNext(After:=ActiveCell).Activate GoTo nochmal End If Exit Sub fehler: Weiter = MsgBox("Suchbegriff nicht gefunden!", vbInformation, "Ergebnis:") End Sub

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Suchen in Datenbank

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread