Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
636to640
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
636to640
636to640
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datensuche und Ausgabe

Datensuche und Ausgabe
19.07.2005 18:43:51
Jens
Hallo Leute
habe mal wieder ein problem
habe ein makro(Globsuch) welches in einer datei alle blätter nach einem stichwort durchsucht und dann ein treffer nach dem anderen anzeigt
meine frage kann ich mir die ergebnisse nicht in einer neuen tabelle anzeigen lassen
vielen dank im voraus

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

Betreff
Datum
Anwender
Anzeige
ja kannst du
19.07.2005 18:55:26
chris-ka
hi
? hast du nicht was vergessen
wie wäre es wenn du den Code posten wüedest damit er angepasst werden kann!
Gruß
Chris
AW: Datensuche und Ausgabe
19.07.2005 19:11:02
Jens
schuldigung habe ich woll vergessen

Sub FindAll()
GlobaleSuche.Show
End Sub


Sub FindGlobal(Suchbegriff As String)
Dim firstCell, nextCell, StringToFind, Antwort As String
Dim mCase, notFound As Boolean
Dim Lookat, Lookin, sOrder As Variant
Dim FindFlag As Integer
Dim ws As Object
GlobaleSuche.Hide
If GlobaleSuche.chkGossKlein Then
mCase = True
Else
mCase = False
End If
If GlobaleSuche.chkGanzeZellen Then
Lookat = xlWhole
Else
Lookat = xlPart
End If
Select Case GlobaleSuche.ComboBox1.Value
Case "Wert"
Lookin = xlValues
Case "Formeln"
Lookin = xlFormulas
Case "Kommentare"
Lookin = xlNotes
End Select
Select Case GlobaleSuche.ComboBox2.Value
Case "In Zeilen"
sOrder = xlByRows
Case "In Spalten"
sOrder = xlByColumns
End Select
notFound = True
For Each ws In Worksheets
StringToFind = Suchbegriff
Set firstCell = Worksheets(ws.Name).Cells.Find(What:=StringToFind, _
Lookin:=Lookin, Lookat:=Lookat, SearchDirection:=xlPrevious, MatchCase:=mCase)
If Not firstCell Is Nothing Then
notFound = False
nextCell = Worksheets(ws.Name).Cells.FindNext _
(After:=Range(firstCell.Address)).Address
If ShowResult(ws.Name, nextCell) Then Exit Sub
Do While firstCell.Address <> nextCell
nextCell = Worksheets(ws.Name).Cells.FindNext _
(After:=Range(nextCell)).Address
If ShowResult(ws.Name, nextCell) Then Exit Sub
Loop
End If
Next ws
If notFound Then MsgBox ("Nicht gefunden"), vbExclamation
GlobaleSuche.Show
End Sub


Function ShowResult(Sheetname, CurCell)
Dim Antwort As String
Worksheets(Sheetname).Activate
Worksheets(Sheetname).Cells.Range(CurCell).Select
Antwort = MsgBox("Wert gefunden in: " & Sheetname & " " & CurCell, vbRetryCancel, "Weitersuchen")
If Antwort = vbCancel Then
ShowResult = True
GlobaleSuche.cmdSuchen.Caption = "Neue Suche"
GlobaleSuche.Show
End If
End Function

Anzeige
AW: Datensuche und Ausgabe
19.07.2005 19:24:01
chris-ka
hi

Function ShowResult(Sheetname, CurCell)
Dim Antwort As String
dim ze as long
'Worksheets(Sheetname).Activate
'ich würde die ergebnisse in eine neue mappe schreiben
'diese Mappe muß aber geöffnet sein
'Name xyz natürlich anpassen!!!
ze = Workbooks("xyz.xls").Sheets(1).Cells(65536, 1).End(xlUp).Row+1
if ze =2 then ze=1
Workbooks("xyz.xls").Sheets(1).Cells(ze, 1).Value = Worksheets(Sheetname).Cells.Range(CurCell).Value
'das wurde neu eingefügt
Antwort = MsgBox("Wert gefunden in: " & Sheetname & " " & CurCell, vbRetryCancel, "Weitersuchen")
If Antwort = vbCancel Then
ShowResult = True
GlobaleSuche.cmdSuchen.Caption = "Neue Suche"
GlobaleSuche.Show
End If
End Function

p.s ist aber nicht getestet da ich die UF nicht komplett nachbauen wolte
die

Sub habe ich nicht geändert
Gruß
Chris

Anzeige
AW: Datensuche und Ausgabe
19.07.2005 19:34:03
chris-ka
hi nochmal erweitert


      
Function ShowResult(Sheetname, CurCell)
Dim Antwort As String
Dim ze As Long
'Worksheets(Sheetname).Activate
'ich würde die ergebnisse in eine neue mappe machen
'diese Mappe muß aber geöffnet sein
'Name xyz natürlich anpassen!!!
ze = Workbooks("xyz.xls").Sheets(1).Cells(65536, 1).End(xlUp).Row + 1
If ze = 2 Then ze = 1
With Workbooks("xyz.xls").Sheets(1)
    .Cells(ze, 1).Value = Worksheets(Sheetname).Cells.Range(CurCell).Value 
'fügt den Wert in A der neuen Mappe zabelle 1 ein
    .Cells(ze, 2).Value = "Wert gefunden in: " & Sheetname 'in Spalte B wird der Tabellenname angezeigt
    .Cells(ze, 3).Value = "in Zelle: " & CurCell 'in Spalte C der Zellbezug
'das wurde neu eingefügt

Antwort = MsgBox("Wert gefunden in: " & Sheetname & " " & CurCell, vbRetryCancel, "Weitersuchen")
If Antwort = vbCancel Then
ShowResult = 
True
GlobaleSuche.cmdSuchen.Caption = "Neue Suche"
GlobaleSuche.Show
End If
End Function 


gruß
chris
Anzeige
!!
19.07.2005 19:41:10
chris-ka
hi
If ze = 2 Then ze = 1
diese zeile rausnehmen
!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige