Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
728to732
728to732
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten suchen mit VBA

Daten suchen mit VBA
Frank
Hallo!
Hab eine Frage.
Mit unterem Makro suche ich einen Wert in einer tabelle.
Meine Arbeitsmappe hat ca. 20 Tabellen. Möchte jetzt nicht nur in einer Tabelle und nicht in der ganzen Mappe suchen sondern nur in den Tabellen 1, 2 und 3 und dort nur in der Spalte A.
Cells.Find(What:=Range("B1"), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Range("F8").Select
Danke!

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Daten suchen mit VBA
13.02.2006 15:23:24
Josef
Hallo Frank!
Und was soll mit den Fundstellen geschehen?
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

AW: Daten suchen mit VBA
13.02.2006 15:40:37
Frank
Die gefundene Zelle (kann nur eine sein) werde ich dann mit gelber farbe unterlegen und den wert in der linken zelle daneben kopieren und in eine neue tabelle kopieren aber das schaffe ich. problem bereitet mir nur das suchen?
Anzeige
AW: Daten suchen mit VBA
13.02.2006 15:50:31
Josef
Hallo Frank!
Probier mal!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub MultiSeek()
Dim objSh As Worksheet, objShTarget As Worksheet
Dim rngSearch As Range
Dim varSheets As Variant
Dim strFirst As String, varFind As Variant
Dim intCount As Integer, lngFirst As Long, lngCalculation As Long

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  lngCalculation = .Calculation
  .Calculation = xlCalculationManual
  .Cursor = xlWait
End With

Set objShTarget = Sheets("Tabelle4") ' Zieltabelle in die kopiert wird! - Anpassen!
lngFirst = objShTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1 'erste freie Zeile in Zieltabelle spalte A!
varSheets = Array("Tabelle1", "Tabelle2", "Tabelle3") ' Tabellen die durchsucht werden! - Anpassen!

varFind = Range("B1") 'Suchbegriff!

For intCount = 0 To UBound(varSheets)
  Set objSh = Sheets(varSheets(intCount))
  
  Set rngSearch = objSh.Range("A:A").Find(What:=varFind, LookIn:=xlFormulas, LookAt:=xlPart)
  
  If Not rngSearch Is Nothing Then
    
    strFirst = rngSearch.Address
    
    Do
      
      rngSearch.Interior.ColorIndex = 6
      rngSearch.Offset(0, 1).Copy objShTarget.Cells(lngFirst, 1)
      lngFirst = lngFirst + 1
      
      Set rngSearch = objSh.Range("A:A").FindNext(rngSearch)
      
    Loop While Not rngSearch Is Nothing And rngSearch.Address <> strFirst
    
  End If
Next

ErrExit:

If Err.Number > 0 Then
  MsgBox Err.Number & vbLf & Err.Description, , "Fehler"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = lngCalculation
  .Cursor = xlDefault
End With

Set rngSearch = Nothing
Set objSh = Nothing
Set objShTarget = Nothing

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Daten suchen mit VBA
14.02.2006 10:17:03
Frank
Hallo!
Funktioniert ganz gut
Hab nur ein Problem ich suche nach zahlen und wenn ich jetz z.B 1 eingebe findet er alle zellen in denen die ziffer 1 enthalten ist als auch 11,12 usw. Wie kann ich das lösen?
Danke
AW: Daten suchen mit VBA
14.02.2006 12:26:45
Josef
Hallo Frank!
Ändere einfach "LookAt:=xlPart" in "LookAt:=xlWhole", dann werden nur ganze Zellen durchsucht!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige