Suchen in variablen Spalten
19.06.2004 20:42:51
Kathrin
ich hoffe ihr könnt´ mir helfen.
Ich habe mir ein Makro "gebastelt", mit kräftiger Unterstützung von Beispielen aus diesem Forum, mit dem ich aus einer Tabelle jede Zeile in der der Suchbegriff vorhanden ist, der in eine Inputbox eingeben wird, in ein anderes Tabellenblatt kopieren.
Meine Kunden-Tabelle in der ich suchen lassen will, ist 55000 Zeilen und 20 Spalten groß. Die Suche dauert viel zu lange, da in allen Zellen gesucht wird.
Hier meine Frage: Wie kann ich über eine Inputbox die Suche auf eine variable Spalte einschränken? Also suche den Begriff "soundso" nur in der Spalte "XY" und kopiere bei Übereinstimmung die Zeile.
Diese Einschränkung ist wichtig, da ich die Kundentabelle nach verschiedenen Kriterien auswerten will.
Habe rumprobiert, bin aber zu keinem Ergebnis gekommen.
Ich hoffe, ich habe mich verständlich ausgedrückt;-)
Sub ListeGefundenerZellentest()
Dim A As Long
Dim R As Long
Dim S As String
Dim Y As String
Dim Z As Range
Dim WS As Worksheet
Dim Liste As Worksheet
Set Liste = ActiveSheet
S = InputBox("Bitte Suchbegriff eingeben:")
If S = "" Then Exit Sub
Y = InputBox("Bitte Spalte eingeben:")
If Y = "" Then Exit Sub
'S = "*" & S & "*" 'es werden auch Zellen angezeigt, die noch mehr als den Suchstring enthalten
With Liste
.Rows("6:" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Clear
.Cells(6, 1) = "Suchbegriff: """ & S & """"
End With
A = 9
For Each WS In ThisWorkbook.Worksheets
R = 0
For Each Z In Range("s:s")
If Z.Text Like S And WS.Name <> Liste.Name Then
If R < Z.Row Then
A = A + 1
Z.EntireRow.Copy
Liste.Rows(A).PasteSpecial Paste:=xlValues
End If
Liste.Rows(A).Borders(xlEdgeBottom).Weight = xlThin
Liste.Cells(A, Z.Column).Interior.ColorIndex = 6
If R < Z.Row Then R = Z.Row
End If
Next Z
Next WS
Liste.Columns.AutoFit
Liste.Cells(A + 1, 1).Select
Sheets("Tabelle2").Select
Range("A1:GC1").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A8").Select
ActiveSheet.Paste
Range("D9").Select
ActiveCell.FormulaR1C1 = "=SUM(R[1]C:R[65527]C)"
Range("D10").Select
ActiveWindow.SmallScroll Down:=-77
Range("D9").Select
Selection.AutoFill Destination:=Range("D9:F9"), Type:=xlFillDefault
Range("D9:F9").Select
Range("E6").Select
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Range("D9:F9").Select
Selection.NumberFormat = "#,##0"
Range("D9:F9").Select
Selection.Font.Bold = True
End Sub
Gruß
Kathrin