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

Durchsuchen von Liste, Ergebniszeilen auf neues Sh

Durchsuchen von Liste, Ergebniszeilen auf neues Sh
17.04.2007 13:47:50
Liste,
Morgen,
ich war vor ca. 2,5 Jahren schon häufiger gast hier und mußte heute mit erschrecken feststellen, dass mein Wissen von damals nur noch sehr rudimentär ist.
Ich habe folgendes Problem:
Es gibt eine Liste mit ca. 3500 Zeilen Spaltes gehen bis Z
Ich würde gerne für Anwender eine Komfortable Suchmaske erstellen. Auf einem extra Blatt wird der zu suchende Begriff eingetragen. Dann werden alle Zeilen, in denene dieser Wert vorkommt, aus der Original Liste rauskopiert, und untereinander ausgewiesen (es wäre schön, wenn man nicht die ganze Zeile kopieren würde, sondern nur bestimmte Spalten. Also nicht Komplette Zeile 13, sondern A:13, D:13, F:13)
Das ist der Code, den ich bislang hab. Dabei funktioniert noch nicht das einlesen des Eingabebefehls und mir ist noch unklar, wie ich die Anzahl der Schleifen für den Kopiervorgang steuern kann. Man müßte ja vorher irgendwie die Anzahl an Zeilen ermitteln, in denen der Suchbegriff vorkommt.
Bin für jeglich Hilfe dankbar

Private Sub CmdSuchen_Click()
Dim EingabeWert
Dim SuchWert
Dim i, n
'Eingabewert auslesen
EingabeWert = Worksheets("Transfer").Range("G6")
'MsgBox (SuchWert)
n = ?
For i = 1 To n
Sheets("A+B+C NW").Select
Selection.Find(What:="*" & Eingabewert & "*", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Selection.Copy
Sheets("Transfer").Select
Rows("13:" & 13 + i).Select
ActiveSheet.Paste
Next i
End Sub


gruß richard

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
close -- Anfrage doppelt
17.04.2007 13:48:41
richard
sorry, habe den beitrag doppelt gepostet.......

AW: Durchsuchen von Liste, Ergebniszeilen auf neue
17.04.2007 13:58:47
Liste,
Also ich weiß nicht ob ich dir hiermit helfen kann, aber das müsste die Funktion sein die du suchst, musst sie aber noch anpassen an den bereich der durchsucht werden soll. Bei mir ist es die komplette Spalte "H" angefangen von der 5 Zeile. Hoffe das hilft dir weiter.
Public maxcell As Integer

Private Sub CommandButton1_Click()
Dim Key As String
Dim filterK() As Variant
Dim counterK As Integer
Dim Acell As Integer
Range("DU5:DU9000").Clear
Selection.AutoFilter Field:=125, Criteria1:="1", Operator:=xlAnd
Key = Me.TextBox1.Value
If Key  "" Then
Worksheets(1).Select
counterK = 0
Do
temp = ActiveSheet.Range("H" & Acell).Value
If InStr(1, temp, Key, 1)  0 Then
counterK = counterK + 1
ReDim Preserve filterK(1 To counterK)
filterK(counterK) = Acell
End If
Acell = Acell + 1
Loop While temp  ""
maxcell = Acell
Acell = 5
Do
temp = ActiveSheet.Range("I" & Acell).Value
If InStr(1, temp, Key, 1)  0 Then
counterK = counterK + 1
ReDim Preserve filterK(1 To counterK)
filterK(counterK) = Acell
End If
Acell = Acell + 1
Loop While Acell  0 Then
counterK = counterK + 1
ReDim Preserve filterK(1 To counterK)
filterK(counterK) = Acell
End If
Acell = Acell + 1
Loop While Acell  0 Then
Range("DU" & filterK(1)).Select
For iCounter = 1 To UBound(filterK)
Union(Selection, Range("DU" & filterK(iCounter))).Select
Next iCounter
For Each Zelle In Selection.Cells
Zelle.Value = "1"
Next
entries = Selection.Cells.Count
files_sum = maxcell - 4
filterWin.Label1.Caption = entries & " of " & files_sum & " Files"
Range("H5").Select
Selection.AutoFilter Field:=125, Criteria1:="1", Operator:=xlAnd
Range("H2").Value = "keyword filter active: "
Else
filterWin.Label1.Caption = "no match"
Range("H2").Value = "keyword filter active:  (no matches)"
End If
Range("H5").Activate
ActiveWindow.ScrollRow = ActiveWindow.ActiveCell.Row
Application.ScreenUpdating = True
End Sub



Private Sub UserForm_Initialize()
maxcell = 10000
End Sub


Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige